comparison lisp/help-fns.el @ 46957:ac5b720640e7

(help-split-fundoc): Replace the function name from the docstring with the one that should be displayed. (help-make-usage): Understand CL style arglists. (describe-function-1): Adapt to the new behavior of help-split-fundoc. (describe-variable): Use delete-region.

46956:2c01ee3e5305

	(print-help-return-message)
	(with-current-buffer standard-output
	  ;; Return the text we displayed.
	  (buffer-string))))))

(defun help-split-fundoc (doc &optional def)
  "Split a function docstring DOC into the actual doc and the usage info.
Return (USAGE . DOC) or nil if there's no usage info."
  ;; Builtins get the calling sequence at the end of the doc string.
  ;; In cases where `function' has been fset to a subr we can't search for
  ;; function's name in the doc string.  Kluge round that using the printed
  ;; representation.  The arg list then shows the wrong function name, but
  ;; that might be a useful hint.
  (when doc
    (let* ((rep (prin1-to-string def))
	   (name (if (string-match " \\([^ ]+\\)>$" rep)
		     (match-string 1 rep) rep)))
      (if (string-match (format "\n\n\\((\\(fn\\|%s\\)\\( .*\\)?)\\)\\'"
				(regexp-quote name))
			doc)
	  (cons (match-string 1 doc)
		(substring doc 0 (match-beginning 0)))))))

(defun help-function-arglist (def)
  ;; Handle symbols aliased to other symbols.
  (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))

   (t t)))

(defun help-make-usage (function arglist)
  (cons (if (symbolp function) function 'anonymous)
	(mapcar (lambda (arg)
		  (if (not (symbolp arg)) arg
		    (let ((name (symbol-name arg)))
		      (if (string-match "\\`&" name) arg
			(intern (upcase name))))))
		arglist)))

	  ;; FIXME: This list can be very long (f.ex. for self-insert-command).
	  (princ (mapconcat 'key-description keys ", ")))
	(when (or remapped keys)
	  (princ ".")
	  (terpri))))
    ;; Handle symbols aliased to other symbols.
    (setq def (indirect-function def))
    (let* ((arglist (help-function-arglist def))
	   (doc (documentation function))
	   (usage (help-split-fundoc doc def)))
      ;; If definition is a keymap, skip arglist note.
      (unless (keymapp def)
	(princ (cond
		(usage (setq doc (cdr usage)) (car usage))
		((listp arglist) (help-make-usage function arglist))

		((let ((fun function))
		   (while (and (symbolp fun)
			       (setq fun (symbol-function fun))
			       (not (setq usage (help-split-fundoc
						 (documentation fun)
						 def)))))
		   usage)
		 (car usage))
		(t "[Missing arglist.  Please make a bug report.]")))
	(terpri))
      (let ((obsolete (and

		(terpri)
		(let ((from (point)))
		  (pp val)
		  (help-xref-on-pp from (point))
		  (if (< (point) (+ from 20))
		      (save-excursion
			(goto-char from)
			(delete-char -1))))))
	    (terpri)
	    (when (local-variable-p variable)
	      (princ (format "Local in buffer %s; " (buffer-name)))
	      (if (not (default-boundp variable))
		  (princ "globally void")

46957:ac5b720640e7

	(print-help-return-message)
	(with-current-buffer standard-output
	  ;; Return the text we displayed.
	  (buffer-string))))))

(defun help-split-fundoc (doc def)
  "Split a function docstring DOC into the actual doc and the usage info.
Return (USAGE . DOC) or nil if there's no usage info.
DEF is the function whose usage we're looking for in DOC."
  ;; Functions can get the calling sequence at the end of the doc string.
  ;; In cases where `function' has been fset to a subr we can't search for
  ;; function's name in the doc string so we use `fn' as the anonymous
  ;; function name instead.
  (when doc
    (let* ((rep (prin1-to-string (indirect-function def)))
	   (name (if (string-match " \\([^ ]+\\)>$" rep)
		     (match-string 1 rep) (prin1-to-string def))))
      (if (string-match (format "\n\n(\\(fn\\|%s\\)\\(\\( .*\\)?)\\)\\'"
				(regexp-quote name))
			doc)
	  (cons (format "(%s%s"
			;; Replace `fn' with the actual function name.
			(if (consp def) "anonymous" def)
			(match-string 2 doc))
		(substring doc 0 (match-beginning 0)))))))

(defun help-function-arglist (def)
  ;; Handle symbols aliased to other symbols.
  (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))

   (t t)))

(defun help-make-usage (function arglist)
  (cons (if (symbolp function) function 'anonymous)
	(mapcar (lambda (arg)
		  (if (not (symbolp arg))
		      (if (and (consp arg) (symbolp (car arg)))
			  ;; CL style default values for optional args.
			  (cons (intern (upcase (symbol-name (car arg))))
				(cdr arg))
			arg)
		    (let ((name (symbol-name arg)))
		      (if (string-match "\\`&" name) arg
			(intern (upcase name))))))
		arglist)))

	  ;; FIXME: This list can be very long (f.ex. for self-insert-command).
	  (princ (mapconcat 'key-description keys ", ")))
	(when (or remapped keys)
	  (princ ".")
	  (terpri))))
    (let* ((arglist (help-function-arglist def))
	   (doc (documentation function))
	   (usage (help-split-fundoc doc function)))
      ;; If definition is a keymap, skip arglist note.
      (unless (keymapp def)
	(princ (cond
		(usage (setq doc (cdr usage)) (car usage))
		((listp arglist) (help-make-usage function arglist))

		((let ((fun function))
		   (while (and (symbolp fun)
			       (setq fun (symbol-function fun))
			       (not (setq usage (help-split-fundoc
						 (documentation fun)
						 function)))))
		   usage)
		 (car usage))
		(t "[Missing arglist.  Please make a bug report.]")))
	(terpri))
      (let ((obsolete (and

		(terpri)
		(let ((from (point)))
		  (pp val)
		  (help-xref-on-pp from (point))
		  (if (< (point) (+ from 20))
		      (delete-region (1- from) from)))))
	    (terpri)
	    (when (local-variable-p variable)
	      (princ (format "Local in buffer %s; " (buffer-name)))
	      (if (not (default-boundp variable))
		  (princ "globally void")