/[emacs]/emacs/lisp/help-fns.el
ViewVC logotype

Diff of /emacs/lisp/help-fns.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.34.4.1 by handa, Fri Apr 16 12:49:50 2004 UTC revision 1.34.4.2 by miles, Mon Jun 28 07:28:40 2004 UTC
# Line 45  If there's no tutorial in that language, Line 45  If there's no tutorial in that language,
45  With ARG, you are asked to choose which language."  With ARG, you are asked to choose which language."
46    (interactive "P")    (interactive "P")
47    (let ((lang (if arg    (let ((lang (if arg
48                      (let ((minibuffer-setup-hook minibuffer-setup-hook))                    (let ((minibuffer-setup-hook minibuffer-setup-hook))
49                        (add-hook 'minibuffer-setup-hook                      (add-hook 'minibuffer-setup-hook
50                                  'minibuffer-completion-help)                                'minibuffer-completion-help)
51                        (read-language-name 'tutorial "Language: " "English"))                      (read-language-name 'tutorial "Language: " "English"))
52                  (if (get-language-info current-language-environment 'tutorial)                  (if (get-language-info current-language-environment 'tutorial)
53                      current-language-environment                      current-language-environment
54                    "English")))                    "English")))
# Line 63  With ARG, you are asked to choose which Line 63  With ARG, you are asked to choose which
63        (setq default-directory (expand-file-name "~/"))        (setq default-directory (expand-file-name "~/"))
64        (setq buffer-auto-save-file-name nil)        (setq buffer-auto-save-file-name nil)
65        (insert-file-contents (expand-file-name filename data-directory))        (insert-file-contents (expand-file-name filename data-directory))
66          (hack-local-variables)
67        (goto-char (point-min))        (goto-char (point-min))
68        (search-forward "\n<<")        (search-forward "\n<<")
69        (beginning-of-line)        (beginning-of-line)
# Line 157  and the file name is displayed in the ec Line 158  and the file name is displayed in the ec
158            ;; Return the text we displayed.            ;; Return the text we displayed.
159            (buffer-string))))))            (buffer-string))))))
160    
161  (defun help-split-fundoc (doc def)  (defun help-split-fundoc (docstring def)
162    "Split a function docstring DOC into the actual doc and the usage info.    "Split a function DOCSTRING into the actual doc and the usage info.
163  Return (USAGE . DOC) or nil if there's no usage info.  Return (USAGE . DOC) or nil if there's no usage info.
164  DEF is the function whose usage we're looking for in DOC."  DEF is the function whose usage we're looking for in DOCSTRING."
165    ;; Functions can get the calling sequence at the end of the doc string.    ;; Functions can get the calling sequence at the end of the doc string.
166    ;; In cases where `function' has been fset to a subr we can't search for    ;; In cases where `function' has been fset to a subr we can't search for
167    ;; function's name in the doc string so we use `fn' as the anonymous    ;; function's name in the doc string so we use `fn' as the anonymous
168    ;; function name instead.    ;; function name instead.
169    (when (and doc (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc))    (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
170      (cons (format "(%s%s"      (cons (format "(%s%s"
171                    ;; Replace `fn' with the actual function name.                    ;; Replace `fn' with the actual function name.
172                    (if (consp def) "anonymous" def)                    (if (consp def) "anonymous" def)
173                    (match-string 1 doc))                    (match-string 1 docstring))
174            (substring doc 0 (match-beginning 0)))))            (substring docstring 0 (match-beginning 0)))))
175    
176  (defun help-add-fundoc-usage (doc arglist)  (defun help-add-fundoc-usage (docstring arglist)
177    "Add the usage info to the docstring DOC.    "Add the usage info to DOCSTRING.
178  If DOC already has a usage info, then just return DOC unchanged.  If DOCSTRING already has a usage info, then just return it unchanged.
179  The usage info is built from ARGLIST.  DOC can be nil.  The usage info is built from ARGLIST.  DOCSTRING can be nil.
180  ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."  ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
181    (unless (stringp doc) (setq doc "Not documented"))    (unless (stringp docstring) (setq docstring "Not documented"))
182    (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t))    (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t))
183        doc        docstring
184      (format "%s%s%s" doc      (concat docstring
185              (if (string-match "\n?\n\\'" doc)              (if (string-match "\n?\n\\'" docstring)
186                  (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")                  (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
187                "\n\n")                "\n\n")
188              (if (and (stringp arglist)              (if (and (stringp arglist)
189                       (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))                       (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
190                  (concat "(fn" (match-string 1 arglist) ")")                  (concat "(fn" (match-string 1 arglist) ")")
191                (help-make-usage 'fn arglist)))))                (format "%S" (help-make-usage 'fn arglist))))))
192    
193  (defun help-function-arglist (def)  (defun help-function-arglist (def)
194    ;; Handle symbols aliased to other symbols.    ;; Handle symbols aliased to other symbols.
# Line 215  ARGLIST can also be t or a string of the Line 216  ARGLIST can also be t or a string of the
216                          (intern (upcase name))))))                          (intern (upcase name))))))
217                  arglist)))                  arglist)))
218    
 (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))))  
   
219  (defun help-C-file-name (subr-or-var kind)  (defun help-C-file-name (subr-or-var kind)
220    "Return the name of the C file where SUBR-OR-VAR is defined.    "Return the name of the C file where SUBR-OR-VAR is defined.
221  KIND should be `var' for a variable or `subr' for a subroutine."  KIND should be `var' for a variable or `subr' for a subroutine."
222    (let ((docbuf (get-buffer-create " *DOC*"))    (let ((docbuf (get-buffer-create " *DOC*"))
223          (name (if (eq 'var kind)          (name (if (eq 'var kind)
224                    (concat "V" (symbol-name subr-or-var))                    (concat "V" (symbol-name subr-or-var))
225                  (concat "F" (help-subr-name subr-or-var)))))                  (concat "F" (subr-name subr-or-var)))))
226      (with-current-buffer docbuf      (with-current-buffer docbuf
227        (goto-char (point-min))        (goto-char (point-min))
228        (if (eobp)        (if (eobp)
# Line 245  KIND should be `var' for a variable or ` Line 232  KIND should be `var' for a variable or `
232        (re-search-backward "S\\(.*\\)")        (re-search-backward "S\\(.*\\)")
233        (let ((file (match-string 1)))        (let ((file (match-string 1)))
234          (if (string-match "\\.\\(o\\|obj\\)\\'" file)          (if (string-match "\\.\\(o\\|obj\\)\\'" file)
235              (replace-match ".c" t t file)              (setq file (replace-match ".c" t t file)))
236            (if (string-match "\\.c\\'" file)
237                (concat "src/" file)
238            file)))))            file)))))
239    
240  (defun help-find-C-source (fun-or-var file kind)  ;;;###autoload
241    "Find the source location where SUBR-OR-VAR is defined in FILE.  (defface help-argument-name '((((supports :slant italic)) :inherit italic))
242  KIND should be `var' for a variable or `subr' for a subroutine."    "Face to highlight argument names in *Help* buffers."
243    (setq file (expand-file-name file help-C-source-directory))    :group 'help)
244    (unless (file-readable-p file)  
245      (error "The C source file %s is not available"  (defun help-default-arg-highlight (arg)
246             (file-name-nondirectory file)))    "Default function to highlight arguments in *Help* buffers.
247    (if (eq 'fun kind)  It returns ARG in face `help-argument-name'; ARG is also
248        (setq fun-or-var (indirect-function fun-or-var)))  downcased if it displays differently than the default
249    (with-current-buffer (find-file-noselect file)  face (according to `face-differs-from-default-p')."
250      (goto-char (point-min))    (propertize (if (face-differs-from-default-p 'help-argument-name)
251      (unless (re-search-forward                    (downcase arg)
252               (if (eq 'fun kind)                  arg)
253                   (concat "DEFUN[ \t\n]*([ \t\n]*\""                'face 'help-argument-name))
254                           (regexp-quote (help-subr-name fun-or-var))  
255                           "\"")  (defun help-do-arg-highlight (doc args)
256                 (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\""    (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
257                         (regexp-quote (symbol-name fun-or-var))))      (modify-syntax-entry ?\- "w")
258               nil t)      (while args
259        (error "Can't find source for %s" fun))        (let ((arg (prog1 (car args) (setq args (cdr args)))))
260      (cons (current-buffer) (match-beginning 0))))          (setq doc (replace-regexp-in-string
261                       ;; This is heuristic, but covers all common cases
262                       ;; except ARG1-ARG2
263                       (concat "\\<"                   ; beginning of word
264                               "\\(?:[a-z-]+-\\)?"     ; for xxx-ARG
265                               "\\("
266                               arg
267                               "\\)"
268                               "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
269                               "\\(?:-[a-z-]+\\)?"     ; for ARG-xxx
270                               "\\>")                  ; end of word
271                       (help-default-arg-highlight arg)
272                       doc t t 1))))
273        doc))
274    
275    (defun help-highlight-arguments (usage doc &rest args)
276      (when usage
277        (with-temp-buffer
278          (insert usage)
279          (goto-char (point-min))
280          (let ((case-fold-search nil)
281                (next (not (or args (looking-at "\\["))))
282                (opt nil))
283            ;; Make a list of all arguments
284            (skip-chars-forward "^ ")
285            (while next
286              (or opt (not (looking-at " &")) (setq opt t))
287              (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
288                  (setq next nil)
289                (setq args (cons (match-string 2) args))
290                (when (and opt (string= (match-string 1) "("))
291                  ;; A pesky CL-style optional argument with default value,
292                  ;; so let's skip over it
293                  (search-backward "(")
294                  (goto-char (scan-sexps (point) 1)))))
295            ;; Highlight aguments in the USAGE string
296            (setq usage (help-do-arg-highlight (buffer-string) args))
297            ;; Highlight arguments in the DOC string
298            (setq doc (and doc (help-do-arg-highlight doc args))))))
299      ;; Return value is like the one from help-split-fundoc, but highlighted
300      (cons usage doc))
301    
302  ;;;###autoload  ;;;###autoload
303  (defun describe-function-1 (function)  (defun describe-function-1 (function)
# Line 335  KIND should be `var' for a variable or ` Line 364  KIND should be `var' for a variable or `
364              (when (re-search-backward              (when (re-search-backward
365                     "^;;; Generated autoloads from \\(.*\\)" nil t)                     "^;;; Generated autoloads from \\(.*\\)" nil t)
366                (setq file-name (match-string 1)))))))                (setq file-name (match-string 1)))))))
367      (when (and (null file-name) (subrp def) help-C-source-directory)      (when (and (null file-name) (subrp def))
368        ;; Find the C source file name.        ;; Find the C source file name.
369        (setq file-name (concat "src/" (help-C-file-name def 'subr))))        (setq file-name (if (get-buffer " *DOC*")
370                              (help-C-file-name def 'subr)
371                            'C-source)))
372      (when file-name      (when file-name
373        (princ " in `")        (princ " in `")
374        ;; We used to add .el to the file name,        ;; We used to add .el to the file name,
375        ;; but that's completely wrong when the user used load-file.        ;; but that's completely wrong when the user used load-file.
376        (princ file-name)        (princ (if (eq file-name 'C-source) "C source code" file-name))
377        (princ "'")        (princ "'")
378        ;; Make a hyperlink to the library.        ;; Make a hyperlink to the library.
379        (with-current-buffer standard-output        (with-current-buffer standard-output
# Line 354  KIND should be `var' for a variable or ` Line 385  KIND should be `var' for a variable or `
385      (when (commandp function)      (when (commandp function)
386        (let* ((remapped (command-remapping function))        (let* ((remapped (command-remapping function))
387               (keys (where-is-internal               (keys (where-is-internal
388                      (or remapped function) overriding-local-map nil nil)))                      (or remapped function) overriding-local-map nil nil))
389                 non-modified-keys)
390            ;; Which non-control non-meta keys run this command?
391            (dolist (key keys)
392              (if (member (event-modifiers (aref key 0)) '(nil (shift)))
393                  (push key non-modified-keys)))
394          (when remapped          (when remapped
395            (princ "It is remapped to `")            (princ "It is remapped to `")
396            (princ (symbol-name remapped))            (princ (symbol-name remapped))
397            (princ "'"))            (princ "'"))
398    
399          (when keys          (when keys
400            (princ (if remapped " which is bound to " "It is bound to "))            (princ (if remapped " which is bound to " "It is bound to "))
401            ;; FIXME: This list can be very long (f.ex. for self-insert-command).            ;; FIXME: This list can be very long (f.ex. for self-insert-command).
402            (princ (mapconcat 'key-description keys ", ")))            ;; If there are many, remove them from KEYS.
403          (when (or remapped keys)            (if (< (length non-modified-keys) 10)
404                  (princ (mapconcat 'key-description keys ", "))
405                (dolist (key non-modified-keys)
406                  (setq keys (delq key keys)))
407                (if keys
408                    (progn
409                      (princ (mapconcat 'key-description keys ", "))
410                      (princ ", and many ordinary text characters"))
411                  (princ "many ordinary text characters"))))
412            (when (or remapped keys non-modified-keys)
413            (princ ".")            (princ ".")
414            (terpri))))            (terpri))))
415      (let* ((arglist (help-function-arglist def))      (let* ((arglist (help-function-arglist def))
416             (doc (documentation function))             (doc (documentation function))
417             (usage (help-split-fundoc doc function)))             (usage (help-split-fundoc doc function)))
418        ;; If definition is a keymap, skip arglist note.        (with-current-buffer standard-output
419        (unless (keymapp def)          ;; If definition is a keymap, skip arglist note.
420          (princ (cond          (unless (keymapp def)
421                  (usage (setq doc (cdr usage)) (car usage))            (let* ((use (cond
422                  ((listp arglist) (help-make-usage function arglist))                          (usage (setq doc (cdr usage)) (car usage))
423                  ((stringp arglist) arglist)                          ((listp arglist)
424                  ;; Maybe the arglist is in the docstring of the alias.                           (format "%S" (help-make-usage function arglist)))
425                  ((let ((fun function))                          ((stringp arglist) arglist)
426                     (while (and (symbolp fun)                          ;; Maybe the arglist is in the docstring of the alias.
427                                 (setq fun (symbol-function fun))                          ((let ((fun function))
428                                 (not (setq usage (help-split-fundoc                             (while (and (symbolp fun)
429                                                   (documentation fun)                                         (setq fun (symbol-function fun))
430                                                   function)))))                                         (not (setq usage (help-split-fundoc
431                     usage)                                                           (documentation fun)
432                   (car usage))                                                           function)))))
433                  ((or (stringp def)                             usage)
434                       (vectorp def))                           (car usage))
435                   (format "\nMacro: %s" (format-kbd-macro def)))                          ((or (stringp def)
436                  (t "[Missing arglist.  Please make a bug report.]")))                               (vectorp def))
437          (terpri))                           (format "\nMacro: %s" (format-kbd-macro def)))
438        (let ((obsolete (and                          (t "[Missing arglist.  Please make a bug report.]")))
439                         ;; function might be a lambda construct.                   (high (help-highlight-arguments use doc)))
440                         (symbolp function)              (insert (car high) "\n")
441                         (get function 'byte-obsolete-info))))              (setq doc (cdr high))))
442          (when obsolete          (let ((obsolete (and
443            (terpri)                           ;; function might be a lambda construct.
444            (princ "This function is obsolete")                           (symbolp function)
445            (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete))))                           (get function 'byte-obsolete-info))))
446            (princ ";") (terpri)            (when obsolete
447            (princ (if (stringp (car obsolete)) (car obsolete)              (princ "\nThis function is obsolete")
448                     (format "use `%s' instead." (car obsolete))))              (when (nth 2 obsolete)
449            (terpri)))                (insert (format " since %s" (nth 2 obsolete))))
450        (terpri)              (insert ";\n"
451        (princ (or doc "Not documented.")))))                      (if (stringp (car obsolete)) (car obsolete)
452                          (format "use `%s' instead." (car obsolete)))
453                        "\n"))
454              (insert "\n"
455                      (or doc "Not documented.")))))))
456    
457    
458  ;; Variables  ;; Variables
# Line 560  it is displayed along with the global va Line 610  it is displayed along with the global va
610                (when (and (null file-name)                (when (and (null file-name)
611                           (integerp (get variable 'variable-documentation)))                           (integerp (get variable 'variable-documentation)))
612                  ;; It's a variable not defined in Elisp but in C.                  ;; It's a variable not defined in Elisp but in C.
613                  (if help-C-source-directory                  (setq file-name
614                      (setq file-name                        (if (get-buffer " *DOC*")
615                            (concat "src/" (help-C-file-name variable 'var)))                            (help-C-file-name variable 'var)
616                    (princ "\n\nDefined in core C code.")))                          'C-source)))
617                (when file-name                (when file-name
618                  (princ "\n\nDefined in `")                  (princ "\n\nDefined in `")
619                  (princ file-name)                  (princ (if (eq file-name 'C-source) "C source code" file-name))
620                  (princ "'.")                  (princ "'.")
621                  (with-current-buffer standard-output                  (with-current-buffer standard-output
622                    (save-excursion                    (save-excursion

Legend:
Removed from v.1.34.4.1  
changed lines
  Added in v.1.34.4.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26