comparison lisp/help-fns.el @ 97916:904041a08605

(describe-simplify-lib-file-name, find-source-lisp-file): Removed. (find-lisp-object-file-name): New function giving preference to files found via load-path instead of loaddefs.el. (describe-function-1): Use new function instead of the removed ones. (Bugs #587, #669, #690)

97915:b533413d3d47

        ;; Highlight arguments in the DOC string
        (setq doc (and doc (help-do-arg-highlight doc args))))))
  ;; Return value is like the one from help-split-fundoc, but highlighted
  (cons usage doc))

;;;###autoload
(defun describe-simplify-lib-file-name (file)
  "Simplify a library name FILE to a relative name, and make it a source file."
  (if file
      ;; Try converting the absolute file name to a library name.
      (let ((libname (file-name-nondirectory file)))
	;; Now convert that back to a file name and see if we get
	;; the original one.  If so, they are equivalent.
	(if (equal file (locate-file libname load-path '("")))
	    (if (string-match "[.]elc\\'" libname)
		(substring libname 0 -1)
	      libname)
	  file))))

(defun find-source-lisp-file (file-name)
  (let* ((elc-file (locate-file (concat file-name
				 (if (string-match "\\.el" file-name)
				     "c"
				   ".elc"))
				 load-path))
	 (str (if (and elc-file (file-readable-p elc-file))
		  (with-temp-buffer
		    (insert-file-contents-literally elc-file nil 0 256)
		    (buffer-string))))
	 (src-file (and str
			(string-match ";;; from file \\(.*\\.el\\)" str)
			(match-string 1 str))))
    (if (and src-file (file-readable-p src-file))
	src-file
      file-name)))

(declare-function ad-get-advice-info "advice" (function))

;;;###autoload
(defun describe-function-1 (function)

		       (ad-get-advice-info function)))
	 ;; If the function is advised, use the symbol that has the
	 ;; real definition, if that symbol is already set up.
	 (real-function
	  (or (and advised
		   (cdr (assq 'origname advised))
		   (fboundp (cdr (assq 'origname advised)))
		   (cdr (assq 'origname advised)))
	      function))
	 ;; Get the real definition.
	 (def (if (symbolp real-function)
		  (symbol-function real-function)
		function))
	 file-name string
	 (beg (if (commandp def) "an interactive " "a "))
	 (pt1 (with-current-buffer (help-buffer) (point)))
	 errtype)
    (setq string
	  (cond ((or (stringp def)
		     (vectorp def))
		 "a keyboard macro")

		((eq (car-safe def) 'lambda)
		 (concat beg "Lisp function"))
		((eq (car-safe def) 'macro)
		 "a Lisp macro")
		((eq (car-safe def) 'autoload)
		 (setq file-name (nth 1 def))
		 (format "%s autoloaded %s"
			 (if (commandp def) "an interactive" "an")
			 (if (eq (nth 4 def) 'keymap) "keymap"
			   (if (nth 4 def) "Lisp macro" "Lisp function"))
			 ))
                ((keymapp def)
                 (let ((is-full nil)
                       (elts (cdr-safe def)))
                   (while elts
                     (if (char-table-p (car-safe elts))

    (if (eq errtype 'alias)
	(princ ",\nwhich is not defined.  Please make a bug report.")
      (with-current-buffer standard-output
	(save-excursion
	  (save-match-data
	    (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
		(help-xref-button 1 'help-function def)))))
      (or file-name
	  (setq file-name (symbol-file function 'defun)))
      (setq file-name (describe-simplify-lib-file-name file-name))
      (when (equal file-name "loaddefs.el")
	;; Find the real def site of the preloaded function.
	;; This is necessary only for defaliases.
	(let ((location
	       (condition-case nil
		   (find-function-search-for-symbol function nil "loaddefs.el")
		 (error nil))))
	  (when location
	    (with-current-buffer (car location)
	      (goto-char (cdr location))
	      (when (re-search-backward
		     "^;;; Generated autoloads from \\(.*\\)" nil t)
		(setq file-name (match-string 1)))))))
      (when (and (null file-name) (subrp def))
	;; Find the C source file name.
	(setq file-name (if (get-buffer " *DOC*")
			    (help-C-file-name def 'subr)
			  'C-source)))
      (when file-name
	(princ " in `")
	;; We used to add .el to the file name,
	;; but that's completely wrong when the user used load-file.
	(princ (if (eq file-name 'C-source) "C source code" file-name))
	(princ "'")
	;; See if lisp files are present where they where installed from.
	(if (not (eq file-name 'C-source))
	    (setq file-name (find-source-lisp-file file-name)))

	;; Make a hyperlink to the library.
	(with-current-buffer standard-output
	  (save-excursion
	    (re-search-backward "`\\([^`']+\\)'" nil t)
	    (help-xref-button 1 'help-function-def real-function file-name))))

				       (get vv 'variable-documentation)))
				t nil nil
				(if (symbolp v) (symbol-name v))))
     (list (if (equal val "")
	       v (intern val)))))
  (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
  (unless (frame-live-p frame) (setq frame (selected-frame)))
  (if (not (symbolp variable))
      (message "You did not specify a variable")
    (save-excursion
      (let ((valvoid (not (with-current-buffer buffer (boundp variable))))
	    val val-start-pos locus)
	;; Extract the value before setting up the output buffer,
	;; in case `buffer' *is* the output buffer.
	(unless valvoid
	  (with-selected-frame frame
	    (with-current-buffer buffer
	      (setq val (symbol-value variable)
		    locus (variable-binding-locus variable)))))
	(help-setup-xref (list #'describe-variable variable buffer)
			 (interactive-p))
	(with-help-window (help-buffer)
	  (with-current-buffer buffer
	    (prin1 variable)
	    ;; Make a hyperlink to the library if appropriate.  (Don't
	    ;; change the format of the buffer's initial line in case
	    ;; anything expects the current format.)
	    (let ((file-name (symbol-file variable 'defvar)))
	      (setq file-name (describe-simplify-lib-file-name file-name))
	      (when (equal file-name "loaddefs.el")
		;; Find the real def site of the preloaded variable.
		(let ((location
		       (condition-case nil
			   (find-variable-noselect variable file-name)
			 (error nil))))
		  (when location
		    (with-current-buffer (car location)
		      (when (cdr location)
			(goto-char (cdr location)))
		      (when (re-search-backward
			     "^;;; Generated autoloads from \\(.*\\)" nil t)
			(setq file-name (match-string 1)))))))
	      (when (and (null file-name)
			 (integerp (get variable 'variable-documentation)))
		;; It's a variable not defined in Elisp but in C.
		(setq file-name
		      (if (get-buffer " *DOC*")
			  (help-C-file-name variable 'var)
			'C-source)))
	      (if file-name
		  (progn
		    (princ " is a variable defined in `")
		    (princ (if (eq file-name 'C-source) "C source code" file-name))
		    (princ "'.\n")

97916:904041a08605

        ;; Highlight arguments in the DOC string
        (setq doc (and doc (help-do-arg-highlight doc args))))))
  ;; Return value is like the one from help-split-fundoc, but highlighted
  (cons usage doc))

;; The following function was compiled from the former functions
;; `describe-simplify-lib-file-name' and `find-source-lisp-file' with
;; some excerpts from `describe-function-1' and `describe-variable'.
;; The only additional twists provided are (1) locate the defining file
;; for autoloaded functions, and (2) give preference to files in the
;; "install directory" (directories found via `load-path') rather than
;; to files in the "compile directory" (directories found by searching
;; the loaddefs.el file).  We autoload it because it's also used by
;; `describe-face' (instead of `describe-simplify-lib-file-name').

;;;###autoload
(defun find-lisp-object-file-name (object type)
  "Guess the file that defined the Lisp object OBJECT, of type TYPE.
OBJECT should be a symbol associated with a function, variable, or face;
  alternatively, it can be a function definition.
If TYPE is `variable', search for a variable definition.
If TYPE is `face', search for a face definition.
If TYPE is the value returned by `symbol-function' for a function symbol,
 search for a function definition.

The return value is the absolute name of a readable file where OBJECT is
defined.  If several such files exist, preference is given to a file
found via `load-path'.  The return value can also be `C-source', which
means that OBJECT is a function or variable defined in C.  If no
suitable file is found, return nil."
  (let* ((autoloaded (eq (car-safe type) 'autoload))
	 (file-name (or (and autoloaded (nth 1 type))
			(symbol-file
			 object (if (memq type (list 'defvar 'defface))
				    type
				  'defun)))))
    (cond
     (autoloaded
      ;; An autoloaded function: Locate the file since `symbol-function'
      ;; has only returned a bare string here.
      (setq file-name
	    (locate-file file-name load-path '(".el" ".elc") 'readable)))
     ((and (stringp file-name)
	   (string-match "[.]*loaddefs.el\\'" file-name))
      ;; An autoloaded variable or face.  Visit loaddefs.el in a buffer
      ;; and try to extract the defining file.  The following form is
      ;; from `describe-function-1' and `describe-variable'.
      (let ((location
	     (condition-case nil
		 (find-function-search-for-symbol object nil file-name)
	       (error nil))))
	(when location
	  (with-current-buffer (car location)
	    (goto-char (cdr location))
	    (when (re-search-backward
		   "^;;; Generated autoloads from \\(.*\\)" nil t)
	      (setq file-name
		    (locate-file
		     (match-string-no-properties 1)
		     load-path nil 'readable))))))))

    (cond
     ((and (not file-name) (subrp type))
      ;; A built-in function.  The form is from `describe-function-1'.
      (if (get-buffer " *DOC*")
	  (help-C-file-name type 'subr)
	'C-source))
     ((and (not file-name) (symbolp object)
	   (integerp (get object 'variable-documentation)))
      ;; A variable defined in C.  The form is from `describe-variable'.
      (if (get-buffer " *DOC*")
	  (help-C-file-name object 'var)
	'C-source))
     ((not (stringp file-name))
      ;; If we don't have a file-name string by now, we lost.
      nil)
     ((let ((lib-name
	     (if (string-match "[.]elc\\'" file-name)
		 (substring-no-properties file-name 0 -1)
	       file-name)))
	;; When the Elisp source file can be found in the install
	;; directory return the name of that file - `file-name' should
	;; have become an absolute file name ny now.
	(and (file-readable-p lib-name) lib-name)))
     ((let* ((lib-name (file-name-nondirectory file-name))
	     ;; The next form is from `describe-simplify-lib-file-name'.
	     (file-name
	      ;; Try converting the absolute file name to a library
	      ;; name, convert that back to a file name and see if we
	      ;; get the original one.  If so, they are equivalent.
	      (if (equal file-name (locate-file lib-name load-path '("")))
		  (if (string-match "[.]elc\\'" lib-name)
		      (substring-no-properties lib-name 0 -1)
		    lib-name)
		file-name))
	     ;; The next three forms are from `find-source-lisp-file'.
	     (elc-file (locate-file
			(concat file-name
				(if (string-match "\\.el\\'" file-name)
				    "c"
				  ".elc"))
			load-path nil 'readable))
	     (str (when elc-file
		    (with-temp-buffer
		      (insert-file-contents-literally elc-file nil 0 256)
		      (buffer-string))))
	     (src-file (and str
			    (string-match ";;; from file \\(.*\\.el\\)" str)
			    (match-string 1 str))))
	(and src-file (file-readable-p src-file) src-file))))))

(declare-function ad-get-advice-info "advice" (function))

;;;###autoload
(defun describe-function-1 (function)

		       (ad-get-advice-info function)))
	 ;; If the function is advised, use the symbol that has the
	 ;; real definition, if that symbol is already set up.
	 (real-function
	  (or (and advised
		   (let ((origname (cdr (assq 'origname advised))))
		     (and (fboundp origname) origname)))
	      function))
	 ;; Get the real definition.
	 (def (if (symbolp real-function)
		  (symbol-function real-function)
		function))
	 file-name string
	 (beg (if (commandp def) "an interactive " "a "))
         (pt1 (with-current-buffer (help-buffer) (point)))
	 errtype)
    (setq string
	  (cond ((or (stringp def)
		     (vectorp def))
		 "a keyboard macro")

		((eq (car-safe def) 'lambda)
		 (concat beg "Lisp function"))
		((eq (car-safe def) 'macro)
		 "a Lisp macro")
		((eq (car-safe def) 'autoload)
		 (format "%s autoloaded %s"
			 (if (commandp def) "an interactive" "an")
			 (if (eq (nth 4 def) 'keymap) "keymap"
			   (if (nth 4 def) "Lisp macro" "Lisp function"))))
                ((keymapp def)
                 (let ((is-full nil)
                       (elts (cdr-safe def)))
                   (while elts
                     (if (char-table-p (car-safe elts))

    (if (eq errtype 'alias)
	(princ ",\nwhich is not defined.  Please make a bug report.")
      (with-current-buffer standard-output
	(save-excursion
	  (save-match-data
	    (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
	      (help-xref-button 1 'help-function def)))))

      (setq file-name (find-lisp-object-file-name function def))
      (when file-name
	(princ " in `")
	;; We used to add .el to the file name,
	;; but that's completely wrong when the user used load-file.
	(princ (if (eq file-name 'C-source) "C source code" file-name))
	(princ "'")
	;; Make a hyperlink to the library.
	(with-current-buffer standard-output
	  (save-excursion
	    (re-search-backward "`\\([^`']+\\)'" nil t)
	    (help-xref-button 1 'help-function-def real-function file-name))))

				       (get vv 'variable-documentation)))
				t nil nil
				(if (symbolp v) (symbol-name v))))
     (list (if (equal val "")
	       v (intern val)))))
  (let (file-name)
    (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
    (unless (frame-live-p frame) (setq frame (selected-frame)))
    (if (not (symbolp variable))
	(message "You did not specify a variable")
      (save-excursion
	(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
	      val val-start-pos locus)
	  ;; Extract the value before setting up the output buffer,
	  ;; in case `buffer' *is* the output buffer.
	  (unless valvoid
	    (with-selected-frame frame
	      (with-current-buffer buffer
		(setq val (symbol-value variable)
		      locus (variable-binding-locus variable)))))
	  (help-setup-xref (list #'describe-variable variable buffer)
			   (interactive-p))
	  (with-help-window (help-buffer)
	    (with-current-buffer buffer
	      (prin1 variable)
	      (setq file-name (find-lisp-object-file-name variable 'defvar))

	      (if file-name
		  (progn
		    (princ " is a variable defined in `")
		    (princ (if (eq file-name 'C-source) "C source code" file-name))
		    (princ "'.\n")