Skip to content

GitLab

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
Hide whitespace changes
Inline Side-by-side
Showing with 166 additions and 163 deletions
lisp/ChangeLog
View file @ 589888fe
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.
......
lisp/help-mode.el
View file @ 589888fe
......@@ -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.
;; 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))))
(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)))))
;;;###autoload
(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