[Emacs-diffs] Changes to emacs/lisp/help-fns.el [emacs-unicode-2]

[Miles Bader]

Index: emacs/lisp/help-fns.el
diff -c emacs/lisp/help-fns.el:1.34.4.1 emacs/lisp/help-fns.el:1.34.4.2
*** emacs/lisp/help-fns.el:1.34.4.1     Fri Apr 16 12:49:50 2004
--- emacs/lisp/help-fns.el      Mon Jun 28 07:28:40 2004
***************
*** 45,54 ****
  With ARG, you are asked to choose which language."
    (interactive "P")
    (let ((lang (if arg
!                   (let ((minibuffer-setup-hook minibuffer-setup-hook))
!                     (add-hook 'minibuffer-setup-hook
!                               'minibuffer-completion-help)
!                     (read-language-name 'tutorial "Language: " "English"))
                (if (get-language-info current-language-environment 'tutorial)
                    current-language-environment
                  "English")))
--- 45,54 ----
  With ARG, you are asked to choose which language."
    (interactive "P")
    (let ((lang (if arg
!                   (let ((minibuffer-setup-hook minibuffer-setup-hook))
!                     (add-hook 'minibuffer-setup-hook
!                               'minibuffer-completion-help)
!                     (read-language-name 'tutorial "Language: " "English"))
                (if (get-language-info current-language-environment 'tutorial)
                    current-language-environment
                  "English")))
***************
*** 63,68 ****
--- 63,69 ----
        (setq default-directory (expand-file-name "~/"))
        (setq buffer-auto-save-file-name nil)
        (insert-file-contents (expand-file-name filename data-directory))
+       (hack-local-variables)
        (goto-char (point-min))
        (search-forward "\n<<")
        (beginning-of-line)
***************
*** 157,193 ****
          ;; 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 (and doc (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc))
      (cons (format "(%s%s"
                  ;; Replace `fn' with the actual function name.
                  (if (consp def) "anonymous" def)
!                 (match-string 1 doc))
!         (substring doc 0 (match-beginning 0)))))
  
! (defun help-add-fundoc-usage (doc arglist)
!   "Add the usage info to the docstring DOC.
! If DOC already has a usage info, then just return DOC unchanged.
! The usage info is built from ARGLIST.  DOC can be nil.
! ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
!   (unless (stringp doc) (setq doc "Not documented"))
!   (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t))
!       doc
!     (format "%s%s%s" doc
!           (if (string-match "\n?\n\\'" doc)
                (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
              "\n\n")
            (if (and (stringp arglist)
                     (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
                (concat "(fn" (match-string 1 arglist) ")")
!             (help-make-usage 'fn arglist)))))
  
  (defun help-function-arglist (def)
    ;; Handle symbols aliased to other symbols.
--- 158,194 ----
          ;; Return the text we displayed.
          (buffer-string))))))
  
! (defun help-split-fundoc (docstring def)
!   "Split a function DOCSTRING 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 DOCSTRING."
    ;; 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 (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
      (cons (format "(%s%s"
                  ;; Replace `fn' with the actual function name.
                  (if (consp def) "anonymous" def)
!                 (match-string 1 docstring))
!         (substring docstring 0 (match-beginning 0)))))
  
! (defun help-add-fundoc-usage (docstring arglist)
!   "Add the usage info to DOCSTRING.
! If DOCSTRING already has a usage info, then just return it unchanged.
! The usage info is built from ARGLIST.  DOCSTRING can be nil.
! ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
!   (unless (stringp docstring) (setq docstring "Not documented"))
!   (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist 
t))
!       docstring
!     (concat docstring
!           (if (string-match "\n?\n\\'" docstring)
                (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
              "\n\n")
            (if (and (stringp arglist)
                     (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
                (concat "(fn" (match-string 1 arglist) ")")
!             (format "%S" (help-make-usage 'fn arglist))))))
  
  (defun help-function-arglist (def)
    ;; Handle symbols aliased to other symbols.
***************
*** 215,241 ****
                        (intern (upcase name))))))
                arglist)))
  
- (defvar help-C-source-directory
-   (let ((dir (expand-file-name "src" source-directory)))
-     (when (and (file-directory-p dir) (file-readable-p dir))
-       dir))
-   "Directory where the C source files of Emacs can be found.
- If nil, do not try to find the source code of functions and variables
- defined in C.")
- 
- (defun help-subr-name (subr)
-   (let ((name (prin1-to-string subr)))
-     (if (string-match "\\`#<subr \\(.*\\)>\\'" name)
-       (match-string 1 name)
-       (error "Unexpected subroutine print name: %s" name))))
- 
  (defun help-C-file-name (subr-or-var kind)
    "Return the name of the C file where SUBR-OR-VAR is defined.
  KIND should be `var' for a variable or `subr' for a subroutine."
    (let ((docbuf (get-buffer-create " *DOC*"))
        (name (if (eq 'var kind)
                  (concat "V" (symbol-name subr-or-var))
!               (concat "F" (help-subr-name subr-or-var)))))
      (with-current-buffer docbuf
        (goto-char (point-min))
        (if (eobp)
--- 216,228 ----
                        (intern (upcase name))))))
                arglist)))
  
  (defun help-C-file-name (subr-or-var kind)
    "Return the name of the C file where SUBR-OR-VAR is defined.
  KIND should be `var' for a variable or `subr' for a subroutine."
    (let ((docbuf (get-buffer-create " *DOC*"))
        (name (if (eq 'var kind)
                  (concat "V" (symbol-name subr-or-var))
!               (concat "F" (subr-name subr-or-var)))))
      (with-current-buffer docbuf
        (goto-char (point-min))
        (if (eobp)
***************
*** 245,274 ****
        (re-search-backward "S\\(.*\\)")
        (let ((file (match-string 1)))
        (if (string-match "\\.\\(o\\|obj\\)\\'" file)
!           (replace-match ".c" t t file)
          file)))))
  
! (defun help-find-C-source (fun-or-var file kind)
!   "Find the source location where SUBR-OR-VAR is defined in FILE.
! KIND should be `var' for a variable or `subr' for a subroutine."
!   (setq file (expand-file-name file help-C-source-directory))
!   (unless (file-readable-p file)
!     (error "The C source file %s is not available"
!          (file-name-nondirectory file)))
!   (if (eq 'fun kind)
!       (setq fun-or-var (indirect-function fun-or-var)))
!   (with-current-buffer (find-file-noselect file)
!     (goto-char (point-min))
!     (unless (re-search-forward
!            (if (eq 'fun kind)
!                (concat "DEFUN[ \t\n]*([ \t\n]*\""
!                        (regexp-quote (help-subr-name fun-or-var))
!                        "\"")
!              (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""
!                      (regexp-quote (symbol-name fun-or-var))))
!            nil t)
!       (error "Can't find source for %s" fun))
!     (cons (current-buffer) (match-beginning 0))))
  
  ;;;###autoload
  (defun describe-function-1 (function)
--- 232,303 ----
        (re-search-backward "S\\(.*\\)")
        (let ((file (match-string 1)))
        (if (string-match "\\.\\(o\\|obj\\)\\'" file)
!           (setq file (replace-match ".c" t t file)))
!       (if (string-match "\\.c\\'" file)
!           (concat "src/" file)
          file)))))
  
! ;;;###autoload
! (defface help-argument-name '((((supports :slant italic)) :inherit italic))
!   "Face to highlight argument names in *Help* buffers."
!   :group 'help)
! 
! (defun help-default-arg-highlight (arg)
!   "Default function to highlight arguments in *Help* buffers.
! It returns ARG in face `help-argument-name'; ARG is also
! downcased if it displays differently than the default
! face (according to `face-differs-from-default-p')."
!   (propertize (if (face-differs-from-default-p 'help-argument-name)
!                   (downcase arg)
!                 arg)
!               'face 'help-argument-name))
! 
! (defun help-do-arg-highlight (doc args)
!   (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
!     (modify-syntax-entry ?\- "w")
!     (while args
!       (let ((arg (prog1 (car args) (setq args (cdr args)))))
!         (setq doc (replace-regexp-in-string
!                    ;; This is heuristic, but covers all common cases
!                    ;; except ARG1-ARG2
!                    (concat "\\<"                   ; beginning of word
!                            "\\(?:[a-z-]+-\\)?"     ; for xxx-ARG
!                            "\\("
!                            arg
!                            "\\)"
!                            "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
!                            "\\(?:-[a-z-]+\\)?"     ; for ARG-xxx
!                            "\\>")                  ; end of word
!                    (help-default-arg-highlight arg)
!                    doc t t 1))))
!     doc))
! 
! (defun help-highlight-arguments (usage doc &rest args)
!   (when usage
!     (with-temp-buffer
!       (insert usage)
!       (goto-char (point-min))
!       (let ((case-fold-search nil)
!             (next (not (or args (looking-at "\\["))))
!             (opt nil))
!         ;; Make a list of all arguments
!         (skip-chars-forward "^ ")
!         (while next
!           (or opt (not (looking-at " &")) (setq opt t))
!           (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
!               (setq next nil)
!             (setq args (cons (match-string 2) args))
!             (when (and opt (string= (match-string 1) "("))
!               ;; A pesky CL-style optional argument with default value,
!               ;; so let's skip over it
!               (search-backward "(")
!               (goto-char (scan-sexps (point) 1)))))
!         ;; Highlight aguments in the USAGE string
!         (setq usage (help-do-arg-highlight (buffer-string) args))
!         ;; 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-function-1 (function)
***************
*** 335,348 ****
            (when (re-search-backward
                   "^;;; Generated autoloads from \\(.*\\)" nil t)
              (setq file-name (match-string 1)))))))
!     (when (and (null file-name) (subrp def) help-C-source-directory)
        ;; Find the C source file name.
!       (setq file-name (concat "src/" (help-C-file-name def 'subr))))
      (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 file-name)
        (princ "'")
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
--- 364,379 ----
            (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 "'")
        ;; Make a hyperlink to the library.
        (with-current-buffer standard-output
***************
*** 354,408 ****
      (when (commandp function)
        (let* ((remapped (command-remapping function))
             (keys (where-is-internal
!                   (or remapped function) overriding-local-map nil nil)))
        (when remapped
          (princ "It is remapped to `")
          (princ (symbol-name remapped))
          (princ "'"))
        (when keys
          (princ (if remapped " which is bound to " "It is bound to "))
          ;; 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))
!               ((stringp arglist) arglist)
!               ;; Maybe the arglist is in the docstring of the alias.
!               ((let ((fun function))
!                  (while (and (symbolp fun)
!                              (setq fun (symbol-function fun))
!                              (not (setq usage (help-split-fundoc
!                                                (documentation fun)
!                                                function)))))
!                  usage)
!                (car usage))
!               ((or (stringp def)
!                    (vectorp def))
!                (format "\nMacro: %s" (format-kbd-macro def)))
!               (t "[Missing arglist.  Please make a bug report.]")))
!       (terpri))
!       (let ((obsolete (and
!                      ;; function might be a lambda construct.
!                      (symbolp function)
!                      (get function 'byte-obsolete-info))))
!       (when obsolete
!         (terpri)
!         (princ "This function is obsolete")
!         (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete))))
!         (princ ";") (terpri)
!         (princ (if (stringp (car obsolete)) (car obsolete)
!                  (format "use `%s' instead." (car obsolete))))
!         (terpri)))
!       (terpri)
!       (princ (or doc "Not documented.")))))
  
  
  ;; Variables
--- 385,458 ----
      (when (commandp function)
        (let* ((remapped (command-remapping function))
             (keys (where-is-internal
!                   (or remapped function) overriding-local-map nil nil))
!            non-modified-keys)
!       ;; Which non-control non-meta keys run this command?
!       (dolist (key keys)
!         (if (member (event-modifiers (aref key 0)) '(nil (shift)))
!             (push key non-modified-keys)))
        (when remapped
          (princ "It is remapped to `")
          (princ (symbol-name remapped))
          (princ "'"))
+ 
        (when keys
          (princ (if remapped " which is bound to " "It is bound to "))
          ;; FIXME: This list can be very long (f.ex. for self-insert-command).
!         ;; If there are many, remove them from KEYS.
!         (if (< (length non-modified-keys) 10)
!             (princ (mapconcat 'key-description keys ", "))
!           (dolist (key non-modified-keys)
!             (setq keys (delq key keys)))
!           (if keys
!               (progn
!                 (princ (mapconcat 'key-description keys ", "))
!                 (princ ", and many ordinary text characters"))
!             (princ "many ordinary text characters"))))
!       (when (or remapped keys non-modified-keys)
          (princ ".")
          (terpri))))
      (let* ((arglist (help-function-arglist def))
           (doc (documentation function))
           (usage (help-split-fundoc doc function)))
!       (with-current-buffer standard-output
!         ;; If definition is a keymap, skip arglist note.
!         (unless (keymapp def)
!           (let* ((use (cond
!                         (usage (setq doc (cdr usage)) (car usage))
!                         ((listp arglist)
!                          (format "%S" (help-make-usage function arglist)))
!                         ((stringp arglist) arglist)
!                         ;; Maybe the arglist is in the docstring of the alias.
!                         ((let ((fun function))
!                            (while (and (symbolp fun)
!                                        (setq fun (symbol-function fun))
!                                        (not (setq usage (help-split-fundoc
!                                                          (documentation fun)
!                                                          function)))))
!                            usage)
!                          (car usage))
!                         ((or (stringp def)
!                              (vectorp def))
!                          (format "\nMacro: %s" (format-kbd-macro def)))
!                         (t "[Missing arglist.  Please make a bug report.]")))
!                  (high (help-highlight-arguments use doc)))
!             (insert (car high) "\n")
!             (setq doc (cdr high))))
!         (let ((obsolete (and
!                          ;; function might be a lambda construct.
!                          (symbolp function)
!                          (get function 'byte-obsolete-info))))
!           (when obsolete
!             (princ "\nThis function is obsolete")
!             (when (nth 2 obsolete)
!               (insert (format " since %s" (nth 2 obsolete))))
!             (insert ";\n"
!                     (if (stringp (car obsolete)) (car obsolete)
!                       (format "use `%s' instead." (car obsolete)))
!                     "\n"))
!           (insert "\n"
!                   (or doc "Not documented.")))))))
  
  
  ;; Variables
***************
*** 560,572 ****
              (when (and (null file-name)
                         (integerp (get variable 'variable-documentation)))
                ;; It's a variable not defined in Elisp but in C.
!               (if help-C-source-directory
!                   (setq file-name
!                         (concat "src/" (help-C-file-name variable 'var)))
!                 (princ "\n\nDefined in core C code.")))
              (when file-name
                (princ "\n\nDefined in `")
!               (princ file-name)
                (princ "'.")
                (with-current-buffer standard-output
                  (save-excursion
--- 610,622 ----
              (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)))
              (when file-name
                (princ "\n\nDefined in `")
!               (princ (if (eq file-name 'C-source) "C source code" file-name))
                (princ "'.")
                (with-current-buffer standard-output
                  (save-excursion