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