xemacs-beta: lisp/help.el comparison

comparison lisp/help.el @ 3368:959746c534f6

[xemacs-hg @ 2006-04-29 16:15:21 by aidan] Support builtin functions in find-function.

author	aidan
date	Sat, 29 Apr 2006 16:15:31 +0000
parents	0f411920c8db
children	b4f4e0cc90f1

comparison

equal deleted inserted replaced

-:84ee3ca77e7f
+:959746c534f6
-;;; help.el --- help commands for XEmacs.
+;; help.el --- help commands for XEmacs.
 ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 2001, 2002, 2003 Ben Wing.
 ;; Maintainer: FSF
 ;;; Code:
 ;; Get the macro make-help-screen when this is compiled,
 ;; or run interpreted, but not when the compiled code is loaded.
 (eval-when-compile (require 'help-macro))
+(require 'loadhist) ;; For symbol-file.
 (defgroup help nil
 "Support for on-line help systems."
 :group 'emacs)
 (define-key help-mode-map "v" 'describe-variable-at-point)
 (define-key help-mode-map "i" 'Info-elisp-ref)
 (define-key help-mode-map "c" 'customize-variable)
 (define-key help-mode-map [tab] 'help-next-symbol)
 (define-key help-mode-map [(shift tab)] 'help-prev-symbol)
+(define-key help-mode-map [return] 'help-find-source-or-scroll-up)
+(define-key help-mode-map [button2] 'help-mouse-find-source-or-track)
 (define-key help-mode-map "n" 'help-next-section)
 (define-key help-mode-map "p" 'help-prev-section)
 (define-derived-mode temp-buffer-mode view-major-mode "Temp"
 "Major mode for viewing temporary buffers.
 "*If non-nil, describe-function will show its arglist,
 unless the function is autoloaded."
 :type 'boolean
 :group 'help-appearance)
-(defun describe-symbol-find-file (symbol)
+(define-obsolete-function-alias
-(loop for (file . load-data) in load-history
+;; Moved to using the version in loadhist.el
-do (when (memq symbol load-data)
+'describe-function-find-symbol
-	 (return file))))
+'symbol-file)
 (define-obsolete-function-alias
 'describe-function-find-file
-'describe-symbol-find-file)
+'symbol-file)
 (defun describe-function (function)
 "Display the full documentation of FUNCTION (a symbol).
 When run interactively, it defaults to any function found by
 `function-at-point'."
 			   (void-function "(alias for undefined function)")
 			   (error "(unexpected error from `documention')")))))
 	  (when (or var fun)
 	    (let ((ex (make-extent b e)))
 	      (require 'hyper-apropos)
 	      (set-extent-property ex 'mouse-face 'highlight)
 	      (set-extent-property ex 'help-symbol sym)
 	      (set-extent-property ex 'face 'hyper-apropos-hyperlink)
 	      (set-extent-property
 	       ex 'context-menu
 nil)))
 (princ "\n")
 (if autoload-file
 	(princ (format "  -- autoloads from \"%s\"\n" autoload-file)))
 (or file-name
-	(setq file-name (describe-symbol-find-file function)))
+	(setq file-name (symbol-file function)))
-(if file-name
+(when file-name
-	(princ (format "  -- loaded from \"%s\"\n" file-name)))
+	(princ "  -- loaded from \"")
-;;     (terpri)
+	(if (not (bufferp standard-output))
+	    (princ file-name)
+	  (let ((opoint (point standard-output))
+		e)
+	    (require 'hyper-apropos)
+	    (princ file-name)
+	    (setq e (make-extent opoint (point standard-output)
+				 standard-output))
+	    (set-extent-property e 'face 'hyper-apropos-hyperlink)
+	    (set-extent-property e 'mouse-face 'highlight)
+	    (set-extent-property e 'find-function-symbol function)))
+	(princ "\"\n"))
 (if describe-function-show-arglist
 	(let ((arglist (function-arglist function)))
 	  (when arglist
 	    (require 'hyper-apropos)
 	    (Help-princ-face arglist 'hyper-apropos-documentation)
 		   (goto-char newp standard-output))
 		 (unless (or (equal doc "")
 			     (eq ?\n (aref doc (1- (length doc)))))
 		   (terpri)))))))))
 ;;; [Obnoxious, whining people who complain very LOUDLY on Usenet
 ;;; are binding this to keys.]
 (defun describe-function-arglist (function)
 (interactive (list (or (function-at-point)
 			 (error "no function call at point"))))
 	     (setq variable newvar)))
 	 (if aliases
 	     (princ (format "%s" aliases)))
 	 (princ (built-in-variable-doc variable))
 	 (princ ".\n")
-	 (let ((file-name (describe-symbol-find-file variable)))
+	 (require 'hyper-apropos)
-	   (if file-name
+	 (let ((file-name (symbol-file variable))
-	       (princ (format "  -- loaded from \"%s\"\n" file-name))))
+	       opoint e)
+	   (when file-name
+	       (princ "  -- loaded from \"")
+	       (if (not (bufferp standard-output))
+		   (princ file-name)
+		 (setq opoint (point standard-output))
+		 (princ file-name)
+		 (setq e (make-extent opoint (point standard-output)
+				      standard-output))
+		 (set-extent-property e 'face 'hyper-apropos-hyperlink)
+		 (set-extent-property e 'mouse-face 'highlight)
+		 (set-extent-property e 'find-variable-symbol variable))
+	       (princ"\"\n")))
 	 (princ "\nValue: ")
-	 (require 'hyper-apropos)
 	 (if (not (boundp variable))
 	     (Help-princ-face "void\n" 'hyper-apropos-documentation)
 	   (Help-prin1-face (symbol-value variable)
 			    'hyper-apropos-documentation)
 	   (terpri))
 (let ((string (eval form)))
 (if (stringp string)
 	(with-displaying-help-buffer
 	 (insert string)))))
+(defun help-find-source-or-scroll-up (&optional pos)
+"Follow any cross reference to source code; if none, scroll up.  "
+(interactive "d")
+(let ((e (extent-at pos nil 'find-function-symbol)))
+(if e
+	(find-function (extent-property e 'find-function-symbol))
+(setq e (extent-at pos nil 'find-variable-symbol))
+(if e
+	  (find-variable (extent-property e 'find-variable-symbol))
+	(view-scroll-lines-up 1)))))
+(defun help-mouse-find-source-or-track (event)
+"Follow any cross reference to source code under the mouse;
+if none, call mouse-track.  "
+(interactive "e")
+(mouse-set-point event)
+(let ((e (extent-at (point) nil 'find-function-symbol)))
+(if e
+	(find-function (extent-property e 'find-function-symbol))
+(setq e (extent-at (point) nil 'find-variable-symbol))
+(if e
+	  (find-variable (extent-property e 'find-variable-symbol))
+	(mouse-track event)))))
 ;;; help.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 3368:959746c534f6