Commit 589888fe authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(help-make-xrefs): Undo the last revert, and replace it with a real fix.

parent 8d720a00
2009-11-15 Stefan Monnier <monnier@iro.umontreal.ca> 2009-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
* help-mode.el (help-make-xrefs): Undo the last revert, and replace it
with a real fix.
* novice.el (disabled-command-function): Add useful args. * novice.el (disabled-command-function): Add useful args.
Setup the help buffer so that [back] works. Setup the help buffer so that [back] works.
Remove redundant call to help-mode. Remove redundant call to help-mode.
......
...@@ -413,170 +413,170 @@ A special reference `back' is made to return back through a stack of ...@@ -413,170 +413,170 @@ A special reference `back' is made to return back through a stack of
help buffers. Variable `help-back-label' specifies the text for help buffers. Variable `help-back-label' specifies the text for
that." that."
(interactive "b") (interactive "b")
(save-excursion (with-current-buffer (or buffer (current-buffer))
(set-buffer (or buffer (current-buffer))) (save-excursion
(goto-char (point-min)) (goto-char (point-min))
;; Skip the header-type info, though it might be useful to parse ;; Skip the header-type info, though it might be useful to parse
;; it at some stage (e.g. "function in `library'"). ;; it at some stage (e.g. "function in `library'").
(forward-paragraph) (forward-paragraph)
(let ((old-modified (buffer-modified-p))) (let ((old-modified (buffer-modified-p)))
(let ((stab (syntax-table)) (let ((stab (syntax-table))
(case-fold-search t) (case-fold-search t)
(inhibit-read-only t)) (inhibit-read-only t))
(set-syntax-table emacs-lisp-mode-syntax-table) (set-syntax-table emacs-lisp-mode-syntax-table)
;; The following should probably be abstracted out. ;; The following should probably be abstracted out.
(unwind-protect (unwind-protect
(progn (progn
;; Info references ;; Info references
(save-excursion (save-excursion
(while (re-search-forward help-xref-info-regexp nil t) (while (re-search-forward help-xref-info-regexp nil t)
(let ((data (match-string 2))) (let ((data (match-string 2)))
(save-match-data (save-match-data
(unless (string-match "^([^)]+)" data) (unless (string-match "^([^)]+)" data)
(setq data (concat "(emacs)" data)))) (setq data (concat "(emacs)" data))))
(help-xref-button 2 'help-info data)))) (help-xref-button 2 'help-info data))))
;; URLs ;; URLs
(save-excursion (save-excursion
(while (re-search-forward help-xref-url-regexp nil t) (while (re-search-forward help-xref-url-regexp nil t)
(let ((data (match-string 1))) (let ((data (match-string 1)))
(help-xref-button 1 'help-url data)))) (help-xref-button 1 'help-url data))))
;; Mule related keywords. Do this before trying ;; Mule related keywords. Do this before trying
;; `help-xref-symbol-regexp' because some of Mule ;; `help-xref-symbol-regexp' because some of Mule
;; keywords have variable or function definitions. ;; keywords have variable or function definitions.
(if help-xref-mule-regexp (if help-xref-mule-regexp
(save-excursion (save-excursion
(while (re-search-forward help-xref-mule-regexp nil t) (while (re-search-forward help-xref-mule-regexp nil t)
(let* ((data (match-string 7)) (let* ((data (match-string 7))
(sym (intern-soft data))) (sym (intern-soft data)))
(cond (cond
((match-string 3) ; coding system ((match-string 3) ; coding system
(and sym (coding-system-p sym) (and sym (coding-system-p sym)
(help-xref-button 6 'help-coding-system sym))) (help-xref-button 6 'help-coding-system sym)))
((match-string 4) ; input method ((match-string 4) ; input method
(and (assoc data input-method-alist) (and (assoc data input-method-alist)
(help-xref-button 7 'help-input-method data))) (help-xref-button 7 'help-input-method data)))
((or (match-string 5) (match-string 6)) ; charset ((or (match-string 5) (match-string 6)) ; charset
(and sym (charsetp sym) (and sym (charsetp sym)
(help-xref-button 7 'help-character-set sym))) (help-xref-button 7 'help-character-set sym)))
((assoc data input-method-alist) ((assoc data input-method-alist)
(help-xref-button 7 'help-character-set data)) (help-xref-button 7 'help-character-set data))
((and sym (coding-system-p sym)) ((and sym (coding-system-p sym))
(help-xref-button 7 'help-coding-system sym)) (help-xref-button 7 'help-coding-system sym))
((and sym (charsetp sym)) ((and sym (charsetp sym))
(help-xref-button 7 'help-character-set sym))))))) (help-xref-button 7 'help-character-set sym)))))))
;; Quoted symbols ;; Quoted symbols
(save-excursion (save-excursion
(while (re-search-forward help-xref-symbol-regexp nil t) (while (re-search-forward help-xref-symbol-regexp nil t)
(let* ((data (match-string 8)) (let* ((data (match-string 8))
(sym (intern-soft data))) (sym (intern-soft data)))
(if sym (if sym
(cond (cond
((match-string 3) ; `variable' &c ((match-string 3) ; `variable' &c
(and (or (boundp sym) ; `variable' doesn't ensure (and (or (boundp sym) ; `variable' doesn't ensure
; it's actually bound ; it's actually bound
(get sym 'variable-documentation)) (get sym 'variable-documentation))
(help-xref-button 8 'help-variable sym))) (help-xref-button 8 'help-variable sym)))
((match-string 4) ; `function' &c ((match-string 4) ; `function' &c
(and (fboundp sym) ; similarly (and (fboundp sym) ; similarly
(help-xref-button 8 'help-function sym))) (help-xref-button 8 'help-function sym)))
((match-string 5) ; `face' ((match-string 5) ; `face'
(and (facep sym) (and (facep sym)
(help-xref-button 8 'help-face sym))) (help-xref-button 8 'help-face sym)))
((match-string 6)) ; nothing for `symbol' ((match-string 6)) ; nothing for `symbol'
((match-string 7) ((match-string 7)
;;; this used: ;; this used:
;;; #'(lambda (arg) ;; #'(lambda (arg)
;;; (let ((location ;; (let ((location
;;; (find-function-noselect arg))) ;; (find-function-noselect arg)))
;;; (pop-to-buffer (car location)) ;; (pop-to-buffer (car location))
;;; (goto-char (cdr location)))) ;; (goto-char (cdr location))))
(help-xref-button 8 'help-function-def sym)) (help-xref-button 8 'help-function-def sym))
((and ((and
(facep sym) (facep sym)
(save-match-data (looking-at "[ \t\n]+face\\W"))) (save-match-data (looking-at "[ \t\n]+face\\W")))
(help-xref-button 8 'help-face sym)) (help-xref-button 8 'help-face sym))
((and (or (boundp sym) ((and (or (boundp sym)
(get sym 'variable-documentation)) (get sym 'variable-documentation))
(fboundp sym)) (fboundp sym))
;; We can't intuit whether to use the ;; We can't intuit whether to use the
;; variable or function doc -- supply both. ;; variable or function doc -- supply both.
(help-xref-button 8 'help-symbol sym)) (help-xref-button 8 'help-symbol sym))
((and ((and
(or (boundp sym) (or (boundp sym)
(get sym 'variable-documentation)) (get sym 'variable-documentation))
(or (or
(documentation-property (documentation-property
sym 'variable-documentation) sym 'variable-documentation)
(condition-case nil (condition-case nil
(documentation-property (documentation-property
(indirect-variable sym) (indirect-variable sym)
'variable-documentation) 'variable-documentation)
(cyclic-variable-indirection nil)))) (cyclic-variable-indirection nil))))
(help-xref-button 8 'help-variable sym)) (help-xref-button 8 'help-variable sym))
((fboundp sym) ((fboundp sym)
(help-xref-button 8 'help-function sym))))))) (help-xref-button 8 'help-function sym)))))))
;; An obvious case of a key substitution: ;; An obvious case of a key substitution:
(save-excursion (save-excursion
(while (re-search-forward (while (re-search-forward
;; Assume command name is only word and symbol ;; Assume command name is only word and symbol
;; characters to get things like `use M-x foo->bar'. ;; characters to get things like `use M-x foo->bar'.
;; Command required to end with word constituent ;; Command required to end with word constituent
;; to avoid `.' at end of a sentence. ;; to avoid `.' at end of a sentence.
"\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t) "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
(let ((sym (intern-soft (match-string 1)))) (let ((sym (intern-soft (match-string 1))))
(if (fboundp sym) (if (fboundp sym)
(help-xref-button 1 'help-function sym))))) (help-xref-button 1 'help-function sym)))))
;; Look for commands in whole keymap substitutions: ;; Look for commands in whole keymap substitutions:
(save-excursion (save-excursion
;; Make sure to find the first keymap. ;; Make sure to find the first keymap.
(goto-char (point-min)) (goto-char (point-min))
;; Find a header and the column at which the command ;; Find a header and the column at which the command
;; name will be found. ;; name will be found.
;; If the keymap substitution isn't the last thing in ;; If the keymap substitution isn't the last thing in
;; the doc string, and if there is anything on the ;; the doc string, and if there is anything on the same
;; same line after it, this code won't recognize the end of it. ;; line after it, this code won't recognize the end of it.
(while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
nil t) nil t)
(let ((col (- (match-end 1) (match-beginning 1)))) (let ((col (- (match-end 1) (match-beginning 1))))
(while (while
(and (not (eobp)) (and (not (eobp))
;; Stop at a pair of blank lines. ;; Stop at a pair of blank lines.
(not (looking-at "\n\\s-*\n"))) (not (looking-at "\n\\s-*\n")))
;; Skip a single blank line. ;; Skip a single blank line.
(and (eolp) (forward-line)) (and (eolp) (forward-line))
(end-of-line) (end-of-line)
(skip-chars-backward "^ \t\n") (skip-chars-backward "^ \t\n")
(if (and (>= (current-column) col) (if (and (>= (current-column) col)
(looking-at "\\(\\sw\\|\\s_\\)+$")) (looking-at "\\(\\sw\\|\\s_\\)+$"))
(let ((sym (intern-soft (match-string 0)))) (let ((sym (intern-soft (match-string 0))))
(if (fboundp sym) (if (fboundp sym)
(help-xref-button 0 'help-function sym)))) (help-xref-button 0 'help-function sym))))
(forward-line)))))) (forward-line))))))
(set-syntax-table stab)) (set-syntax-table stab))
;; Delete extraneous newlines at the end of the docstring ;; Delete extraneous newlines at the end of the docstring
(goto-char (point-max)) (goto-char (point-max))
(while (and (not (bobp)) (bolp)) (while (and (not (bobp)) (bolp))
(delete-char -1)) (delete-char -1))
(insert "\n") (insert "\n")
(when (or help-xref-stack help-xref-forward-stack) (when (or help-xref-stack help-xref-forward-stack)
(insert "\n")) (insert "\n"))
;; Make a back-reference in this buffer if appropriate. ;; Make a back-reference in this buffer if appropriate.
(when help-xref-stack (when help-xref-stack
(help-insert-xref-button help-back-label 'help-back (help-insert-xref-button help-back-label 'help-back
(current-buffer))) (current-buffer)))
;; Make a forward-reference in this buffer if appropriate. ;; Make a forward-reference in this buffer if appropriate.
(when help-xref-forward-stack (when help-xref-forward-stack
(when help-xref-stack (when help-xref-stack
(insert "\t")) (insert "\t"))
(help-insert-xref-button help-forward-label 'help-forward (help-insert-xref-button help-forward-label 'help-forward
(current-buffer))) (current-buffer)))
(when (or help-xref-stack help-xref-forward-stack) (when (or help-xref-stack help-xref-forward-stack)
(insert "\n"))) (insert "\n")))
;; View mode steals RET from us. ;; View mode steals RET from us.
(set (make-local-variable 'minor-mode-overriding-map-alist) (set (make-local-variable 'minor-mode-overriding-map-alist)
(list (cons 'view-mode help-xref-override-view-map))) (list (cons 'view-mode help-xref-override-view-map)))
(set-buffer-modified-p old-modified)))) (set-buffer-modified-p old-modified)))))
;;;###autoload ;;;###autoload
(defun help-xref-button (match-number type &rest args) (defun help-xref-button (match-number type &rest args)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment