(help-make-xrefs): Undo the last revert, and replace it with a real fix.
This commit is contained in:
Stefan Monnier
parent
8d720a0066
commit
589888fe21
2 changed files with 165 additions and 162 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue