From xemacs-m  Fri Sep 26 07:49:34 1997
Received: from kurims.kurims.kyoto-u.ac.jp (kurims.kurims.kyoto-u.ac.jp [130.54.16.1])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id HAA20785
	for <xemacs-beta@xemacs.org>; Fri, 26 Sep 1997 07:47:37 -0500 (CDT)
Received: from boron.kurims.kyoto-u.ac.jp (boron.kurims.kyoto-u.ac.jp [130.54.16.65]) by kurims.kurims.kyoto-u.ac.jp (8.8.5/3.4W2) with SMTP id VAA21868 for <xemacs-beta@xemacs.org>; Fri, 26 Sep 1997 21:47:16 +0900 (JST)
Received: (from petersen@localhost) by boron.kurims.kyoto-u.ac.jp (SMI-8.6/3.5Wbeta) id VAA10577; Fri, 26 Sep 1997 21:47:16 +0900
To: XEmacs Beta List <xemacs-beta@xemacs.org>
Subject: [patch] help (includes newest find-func)
X-Face: fOOYdM>Ct-+jZ!MfKWRl?5e=(j4]xHE~<%D)$=FuN"@nP]"fi8stnK9>1fW>1HR[fj\=i%q0'l2G]0[H'R*m(fm^Og;iG>lBmr{anp!LG[)PD}g^XbG.(@oIi8;y)8+C"HV5}8NQ`HR7~P{+$AEEPo,N>,IwIbd:Dq6\"Bi#Aq\^lJ~dmwnUkc-Xb{k3\dZnF7j,$enH=Ybr<9v,Kzi-T|urefU:c{$pC)T5yvnRO0T+D&Z9{B8ulAd5X#c?Z|}vv^qhBjEj
X-Emacs: 20.3 "Sarajevo" XEmacs  Lucid (beta23) with mule
Mime-Version: 1.0 (generated by SEMI MIME-Edit 0.86 "Naka-Tsurugi")
Content-Type: multipart/mixed;
 boundary="Multipart_Fri_Sep_26_21:47:16_1997-1"
Content-Transfer-Encoding: 7bit
From: Jens-Ulrik Holger Petersen <petersen@kurims.kyoto-u.ac.jp>
Date: 26 Sep 1997 21:47:16 +0900
Message-ID: <lbafh0nsx7.fsf@boron.kurims.kyoto-u.ac.jp>
Lines: 368

--Multipart_Fri_Sep_26_21:47:16_1997-1
Content-Type: text/plain; charset=US-ASCII

1997-09-26  Jens-Ulrik Holger Petersen  <petersen@kurims.kyoto-u.ac.jp>

	* help.el (describe-function-at-point): new function.
	(describe-variable-at-point): ditto.
	(help-next-symbol): ditto.
	(help-prev-symbol): ditto.
	(describe-function): Mention `find-function-function' in
 	docstring.  Use `function-history' in completing-read.
	(describe-function-1): Only print one filename, even if we know
 	two!  Use `variable-history' in completing-read.
	(where-is): Mention `find-function-function' in docstring.
	(find-function-function): improve docstring.
	(find-function-noselect): Remove optional arg.  Now finds
 	libraries explicitly loaded from outside `load-path' as it should.
	Search also for cl's defun*.  Return a pair instead of a list.
	(find-function-read-function): use `function-history'.
	(find-function-do-it): new function.
	(find-function): Remove optional arg.  Use `find-function-do-it'.
	(find-function-other-window): ditto.
	(find-function-other-frame): ditto.
	(find-function-at-point): new function.



--Multipart_Fri_Sep_26_21:47:16_1997-1
Content-Type: text/plain; charset=US-ASCII

--- lisp/prim/help.el.orig	Fri Sep 26 21:25:28 1997
+++ lisp/prim/help.el		Fri Sep 26 21:25:28 1997
@@ -185,7 +185,33 @@
   )
 
 (define-key help-mode-map "q" 'help-mode-quit)
-(define-key help-mode-map 'delete 'scroll-down)
+(define-key help-mode-map "f" 'find-function-at-point)
+
+(defun describe-function-at-point ()
+  "Describe directly the function at point in the other window."
+  (interactive)
+  (let ((symb (function-at-point)))
+    (when symb
+      (describe-function symb))))
+(defun describe-variable-at-point ()
+  "Describe directly the variable at point in the other window."
+  (interactive)
+  (let ((symb (variable-at-point)))
+    (when symb
+      (describe-variable symb))))
+(defun help-next-symbol ()
+  "Move point to the next quoted symbol."
+  (interactive)
+  (search-forward "`" nil t))
+(defun help-prev-symbol ()
+  "Move point to the previous quoted symbol."
+  (interactive)
+  (search-backward "'" nil t))
+(define-key help-mode-map "d" 'describe-function-at-point)
+(define-key help-mode-map "v" 'describe-variable-at-point)
+(define-key help-mode-map [tab] 'help-next-symbol)
+(define-key help-mode-map [(shift tab)] 'help-prev-symbol)
+
 
 (defun help-mode-quit ()
   "Exits from help mode, possibly restoring the previous window configuration.
@@ -781,12 +807,15 @@
 	     file)
 	 (while files
 	   (if (memq function (cdr (car files)))
-	       (setq file (car (car files)) files nil))
+	       (setq file (car (car files))
+		     files nil))
 	   (setq files (cdr files)))
 	 file))
 
 (defun describe-function (function)
-  "Display the full documentation of FUNCTION (a symbol)."
+  "Display the full documentation of FUNCTION (a symbol).
+When run interactively, it defaults to any function found by the
+value of `find-function-function'."
   (interactive
     (let* ((fn (funcall find-function-function))
            (val (let ((enable-recursive-minibuffers t))
@@ -795,7 +824,7 @@
                         (format (gettext "Describe function (default %s): ")
 				fn)
                         (gettext "Describe function: "))
-                    obarray 'fboundp t))))
+                    obarray 'fboundp t nil 'function-history))))
       (list (if (equal val "") fn (intern val)))))
   (with-displaying-help-buffer
    (lambda ()
@@ -918,10 +947,8 @@
     (princ "\n")
     (or file-name
 	(setq file-name (describe-function-find-file function)))
-    (if file-name
-	(princ (format "  -- loads from \"%s\"\n" file-name) stream))
-    (if home
-	(princ (format "  -- loaded from \"%s\"\n" home)) stream)
+    (if (or home file-name)
+	(princ (format "  -- defined in \"%s\"\n" (or home file-name)) stream))
 ;;     (terpri stream)
     (if describe-function-show-arglist
         (let ((arglist
@@ -1071,7 +1098,7 @@
                    (if v
                        (format "Describe variable (default %s): " v)
                        (gettext "Describe variable: "))
-                   obarray 'boundp t))))
+                   obarray 'boundp t nil 'variable-history))))
      (list (if (equal val "") v (intern val)))))
   (with-displaying-help-buffer
    (lambda ()
@@ -1161,7 +1188,9 @@
 
 (defun where-is (definition)
   "Print message listing key sequences that invoke specified command.
-Argument is a command definition, usually a symbol with a function definition."
+Argument is a command definition, usually a symbol with a function definition.
+When run interactively, it defaults to any function found by the
+value of `find-function-function'."
   (interactive
    (let ((fn (funcall find-function-function))
 	 (enable-recursive-minibuffers t)	     
@@ -1301,8 +1330,8 @@
 ;; find-function stuff
 
 (defvar find-function-function 'function-at-point
-  "*The function used by `find-function' to select the function near
-point.
+  "*The function used by `describe-function', `where-is' and
+`find-function' to select the function near point.
 
 For example `function-at-point' or `function-called-at-point'.")
 
@@ -1313,16 +1342,15 @@
 default.")
 
 
-(defun find-function-noselect (function &optional path)
-  "Returns list `(buffer point)' pointing to the definition of FUNCTION.
+(defun find-function-noselect (function)
+  "Returns a pair `(buffer . point)' pointing to the definition of FUNCTION.
 
-Finds the emacs-lisp library containing the definition of FUNCTION
-in a buffer and places point before the definition.  The buffer is
+Finds the Emacs Lisp library containing the definition of FUNCTION
+in a buffer and the point of the definition.  The buffer is
 not selected.
 
-If the optional argument PATH is given, the library where FUNCTION is
-defined is searched in PATH instead of `load-path' (see
-`find-function-source-path')."
+The library where FUNCTION is defined is searched for in
+`find-function-source-path', if non `nil', otherwise in `load-path'."
   (and (subrp (symbol-function function))
        (error "%s is a primitive function" function))
   (if (not function)
@@ -1332,7 +1360,7 @@
     (while (symbolp def)
       (or (eq def function)
 	  (if aliases
-	      (setq aliases (concat aliases 
+	      (setq aliases (concat aliases
 				    (format ", which is an alias for %s"
 					    (symbol-name def))))
 	    (setq aliases (format "an alias for %s" (symbol-name
@@ -1348,37 +1376,43 @@
 		((compiled-function-p def)
 		 (substring (compiled-function-annotation def) 0 -4))))
     (if (null library)
-	(error "Can't find library"))
-    (if (string-match "\\(\\.elc?\\'\\)" library)
+	(error (format "Don't know where `%s' is defined" function)))
+    (if (string-match "\\.el\\(c\\)\\'" library)
 	(setq library (substring library 0 (match-beginning 1))))
-    (let* ((path (or path find-function-source-path))
+    (let* ((path find-function-source-path)
 	   (compression (or (rassq 'jka-compr-handler file-name-handler-alist)
 			    (member 'crypt-find-file-hook find-file-hooks)))
-	   (filename (or (locate-library (concat library ".el")
-					 t path)
-			 (locate-library library t path)
-			 (if compression
-			     (or (locate-library (concat library ".el.gz")
-						 t path)
-				 (locate-library (concat library ".gz")
-						 t path))))))
+	   (filename (if (file-exists-p library)
+			 library
+		       (if (string-match "\\(\\.el\\)\\'" library)
+			   (setq library (substring library 0
+						    (match-beginning 1))))
+		       (or (locate-library (concat library ".el")
+					   t path)
+			   (locate-library library t path)
+			   (if compression
+			       (or (locate-library (concat library ".el.gz")
+						   t path)
+				   (locate-library (concat library ".gz")
+						   t path)))))))
       (if (not filename)
 	  (error "The library \"%s\" is not in the path." library))
       (save-excursion
 	(set-buffer (find-file-noselect filename))
 	(save-match-data
 	  (let (;; avoid defconst, defgroup, defvar (any others?)
-		(re (format "^\\s-*(def[^cgv\W]\\w+\\s-+%s\\s-" function))
+		(regexp
+		 (format "^\\s-*(def[^cgv\W]\\w+\\*?\\s-+%s\\s-" function))
 		(syntable (syntax-table)))
 	    (set-syntax-table emacs-lisp-mode-syntax-table)
 	    (goto-char (point-min))
 	    (if (prog1
-		  (re-search-forward re nil t)
+		    (re-search-forward regexp nil t)
 		  (set-syntax-table syntable))
 		(progn
 		    (beginning-of-line)
-		    (list (current-buffer) (point)))
-	      (error "Cannot find definition of %s" function))))))))
+		    (cons (current-buffer) (point)))
+	      (error "Cannot find definition of `%s'" function))))))))
 
 (defun function-at-point ()
   (or (condition-case ()
@@ -1412,70 +1446,72 @@
 The function named by `find-function-function' is used to select the
 default function."
   (let ((fn (funcall find-function-function))
-	(enable-recursive-minibuffers t)	     
+	(enable-recursive-minibuffers t)
 	val)
     (setq val (completing-read
 	       (if fn
 		   (format "Find function (default %s): " fn)
 		 "Find function: ")
-	       obarray 'fboundp t))
+	       obarray 'fboundp t nil 'function-history))
     (list (if (equal val "")
 	      fn (intern val)))))
 
+(defun find-function-do-it (function switch-fn)
+  "find elisp FUNCTION in a buffer and display it with SWITCH-FN.
+Point is saved in the buffer if it is one of the current buffers."
+  (let ((orig-point (point))
+	(orig-buffers (buffer-list))
+	(buffer-point (find-function-noselect function)))
+    (if buffer-point
+	(progn
+	  (funcall switch-fn (car buffer-point))
+	  (if (memq (car buffer-point) orig-buffers)
+	      (push-mark orig-point))
+	  (goto-char (cdr buffer-point))
+	  (recenter 0)))))
 
-(defun find-function (function &optional path)
+(defun find-function (function)
   "Find the definition of the function near point in the current window.
 
-Finds the emacs-lisp library containing the definition of the function
-near point (selected by `find-function-function') and places point
-before the definition.
+Finds the Emacs Lisp library containing the definition of the function
+near point (selected by `find-function-function') in a buffer and
+places point before the definition.  Point is saved in the buffer if
+it is one of the current buffers.
 
-If the optional argument PATH is given, the library where FUNCTION is
-defined is searched in PATH instead of `load-path'"
+The library where FUNCTION is defined is searched for in
+`find-function-source-path', if non `nil', otherwise in `load-path'."
   (interactive (find-function-read-function))
-  (let ((buffer-point (find-function-noselect function path)))
-    (if buffer-point
-	(progn
-	  (switch-to-buffer (car buffer-point))
-	  (goto-char (cadr buffer-point))
-	  (recenter 0)))))
+  (find-function-do-it function 'switch-to-buffer))
 
-(defun find-function-other-window (function &optional path)
+(defun find-function-other-window (function)
   "Find the definition of the function near point in the other window.
 
-Finds the emacs-lisp library containing the definition of the function
-near point (selected by `find-function-function') and places point
-before the definition.
+Finds the Emacs Lisp library containing the definition of the function
+near point (selected by `find-function-function') in a buffer and
+places point before the definition.  Point is saved in the buffer if
+it is one of the current buffers.
 
-If the optional argument PATH is given, the library where FUNCTION is
-defined is searched in PATH instead of `load-path'"
+The library where FUNCTION is defined is searched for in
+`find-function-source-path', if non `nil', otherwise in `load-path'."
   (interactive (find-function-read-function))
-  (let ((buffer-point (find-function-noselect function path)))
-    (if buffer-point
-	(progn
-	  (switch-to-buffer-other-window (car buffer-point))
-	  (goto-char (cadr buffer-point))
-	  (recenter 0)))))
+  (find-function-do-it function 'switch-to-buffer-other-window))
 
-(defun find-function-other-frame (function &optional path)
+(defun find-function-other-frame (function)
   "Find the definition of the function near point in the another frame.
 
-Finds the emacs-lisp library containing the definition of the function
-near point (selected by `find-function-function') and places point
-before the definition.
+Finds the Emacs Lisp library containing the definition of the function
+near point (selected by `find-function-function') in a buffer and
+places point before the definition.  Point is saved in the buffer if
+it is one of the current buffers.
 
-If the optional argument PATH is given, the library where FUNCTION is
-defined is searched in PATH instead of `load-path'"
+The library where FUNCTION is defined is searched for in
+`find-function-source-path', if non `nil', otherwise in `load-path'."
   (interactive (find-function-read-function))
-  (let ((buffer-point (find-function-noselect function path)))
-    (if buffer-point
-	(progn
-	  (switch-to-buffer-other-frame (car buffer-point))
-	  (goto-char (cadr buffer-point))
-	  (recenter 0)))))
+  (find-function-do-it function 'switch-to-buffer-other-frame))
 
 (defun find-function-on-key (key)
-  "Find the function that KEY invokes.  KEY is a string."
+  "Find the function that KEY invokes.  KEY is a string.
+Point is saved if FUNCTION is in the current buffer."
   (interactive "kFind function on key: ")
   (let ((defn (key-or-menu-binding key)))
     (if (or (null defn) (integerp defn))
@@ -1483,6 +1519,13 @@
       (if (and (consp defn) (not (eq 'lambda (car-safe defn))))
 	  (message "runs %s" (prin1-to-string defn))
 	(find-function-other-window defn)))))
+
+(defun find-function-at-point ()
+  "Find directly the function at point in the other window."
+  (interactive)
+  (let ((symb (function-at-point)))
+    (when symb
+      (find-function-other-window symb))))
 
 (define-key ctl-x-map "F" 'find-function)
 (define-key ctl-x-4-map "F" 'find-function-other-window)

--Multipart_Fri_Sep_26_21:47:16_1997-1
Content-Type: text/plain; charset=US-ASCII


-- 
Jens
---
It is only the great men who are truly obscene.  If they had not dared
to be obscene, they could never have dared to be great.
		-- Havelock Ellis

--Multipart_Fri_Sep_26_21:47:16_1997-1--

