(setq-default help-xref-stack nil help-xref-stack-item nil)
-
+(defcustom help-mode-hook nil
+ "Hook run by `help-mode'."
+ :type 'hook
+ :group 'help)
\f
;; Button types used by help
-;; Make some button types that all use the same naming conventions
-(dolist (help-type '("function" "variable" "face"
- "coding-system" "input-method" "character-set"))
- (define-button-type (intern (purecopy (concat "help-" help-type)))
- 'help-function (intern (concat "describe-" help-type))
- 'help-echo (purecopy (concat "mouse-2, RET: describe this " help-type))
- 'action #'help-button-action))
+(define-button-type 'help-xref
+ 'action #'help-button-action)
+
+(defun help-button-action (button)
+ "Call BUTTON's help function."
+ (help-do-xref (button-start button)
+ (button-get button 'help-function)
+ (button-get button 'help-args)))
+
+;; These 6 calls to define-button-type were generated in a dolist
+;; loop, but that is bad because it means these button types don't
+;; have an easily found definition.
+
+(define-button-type 'help-function
+ :supertype 'help-xref
+ 'help-function 'describe-function
+ 'help-echo (purecopy "mouse-2, RET: describe this function"))
+
+(define-button-type 'help-variable
+ :supertype 'help-xref
+ 'help-function 'describe-variable
+ 'help-echo (purecopy "mouse-2, RET: describe this variable"))
+
+(define-button-type 'help-face
+ :supertype 'help-xref
+ 'help-function 'describe-face
+ 'help-echo (purecopy "mouse-2, RET: describe this face"))
+
+(define-button-type 'help-coding-system
+ :supertype 'help-xref
+ 'help-function 'describe-coding-system
+ 'help-echo (purecopy "mouse-2, RET: describe this coding system"))
+
+(define-button-type 'help-input-method
+ :supertype 'help-xref
+ 'help-function 'describe-input-method
+ 'help-echo (purecopy "mouse-2, RET: describe this input method"))
+
+(define-button-type 'help-character-set
+ :supertype 'help-xref
+ 'help-function 'describe-character-set
+ 'help-echo (purecopy "mouse-2, RET: describe this character set"))
;; make some more ideosyncratic button types
(define-button-type 'help-symbol
+ :supertype 'help-xref
'help-function #'help-xref-interned
- 'help-echo (purecopy "mouse-2, RET: describe this symbol")
- 'action #'help-button-action)
+ 'help-echo (purecopy "mouse-2, RET: describe this symbol"))
(define-button-type 'help-back
+ :supertype 'help-xref
'help-function #'help-xref-go-back
- 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer")
- 'action #'help-button-action)
+ 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer"))
(define-button-type 'help-info
+ :supertype 'help-xref
'help-function #'info
- 'help-echo (purecopy"mouse-2, RET: read this Info node")
- 'action #'help-button-action)
+ 'help-echo (purecopy"mouse-2, RET: read this Info node"))
(define-button-type 'help-customize-variable
+ :supertype 'help-xref
'help-function (lambda (v)
(if help-xref-stack
(pop help-xref-stack))
(customize-variable v))
- 'help-echo (purecopy "mouse-2, RET: customize variable")
- 'action #'help-button-action)
+ 'help-echo (purecopy "mouse-2, RET: customize variable"))
+
+(define-button-type 'help-customize-face
+ :supertype 'help-xref
+ 'help-function (lambda (v)
+ (if help-xref-stack
+ (pop help-xref-stack))
+ (customize-face v))
+ 'help-echo (purecopy "mouse-2, RET: customize face"))
(define-button-type 'help-function-def
+ :supertype 'help-xref
'help-function (lambda (fun file)
(require 'find-func)
;; Don't use find-function-noselect because it follows
fun nil file)))
(pop-to-buffer (car location))
(goto-char (cdr location))))
- 'help-echo (purecopy "mouse-2, RET: find function's definition")
- 'action #'help-button-action)
+ 'help-echo (purecopy "mouse-2, RET: find function's definition"))
(define-button-type 'help-variable-def
+ :supertype 'help-xref
'help-function (lambda (var &optional file)
(let ((location
(find-variable-noselect var file)))
(pop-to-buffer (car location))
(goto-char (cdr location))))
- 'help-echo (purecopy"mouse-2, RET: find variable's definition")
- 'action #'help-button-action)
-
-(defun help-button-action (button)
- "Call BUTTON's help function."
- (help-do-xref (button-start button)
- (button-get button 'help-function)
- (button-get button 'help-args)))
+ 'help-echo (purecopy"mouse-2, RET: find variable's definition"))
\f
;;;###autoload
-(define-derived-mode help-mode nil "Help"
+(defun help-mode ()
"Major mode for viewing help text and navigating references in it.
Entry to this mode runs the normal hook `help-mode-hook'.
Commands:
\\{help-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map help-mode-map)
+ (setq mode-name "Help")
+ (setq major-mode 'help-mode)
+ (make-local-variable 'font-lock-defaults)
(setq font-lock-defaults nil) ; font-lock would defeat xref
(view-mode)
(make-local-variable 'view-no-disable-on-exit)
- (setq view-no-disable-on-exit t))
+ (setq view-no-disable-on-exit t)
+ (run-hooks 'help-mode-hook))
;;;###autoload
(defun help-mode-setup ()
"Non-nil when following a help cross-reference.")
(defun help-buffer ()
- (unless (equal help-xref-following (eq major-mode 'help-mode))
- (debug))
(buffer-name ;for with-output-to-temp-buffer
(if help-xref-following
(current-buffer)
(set-syntax-table emacs-lisp-mode-syntax-table)
(narrow-to-region from to)
(goto-char (point-min))
- (while (not (eobp))
- (cond
- ((looking-at "\"") (forward-sexp 1))
- ((looking-at "#<") (search-forward ">" nil 'move))
- ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
- (let* ((sym (intern-soft (match-string 1)))
- (type (cond ((fboundp sym) 'help-function)
- ((or (memq sym '(t nil))
- (keywordp sym))
- nil)
- ((and sym (boundp sym))
- 'help-variable))))
- (when type (help-xref-button 1 type sym)))
- (goto-char (match-end 1)))
- (t (forward-char 1))))))
+ (condition-case nil
+ (while (not (eobp))
+ (cond
+ ((looking-at "\"") (forward-sexp 1))
+ ((looking-at "#<") (search-forward ">" nil 'move))
+ ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
+ (let* ((sym (intern-soft (match-string 1)))
+ (type (cond ((fboundp sym) 'help-function)
+ ((or (memq sym '(t nil))
+ (keywordp sym))
+ nil)
+ ((and sym (boundp sym))
+ 'help-variable))))
+ (when type (help-xref-button 1 type sym)))
+ (goto-char (match-end 1)))
+ (t (forward-char 1))))
+ (error nil))))
(set-syntax-table ost))))
\f
(sdoc
;; We now have a help buffer on the variable.
;; Insert the function and face text before it.
- (when (or fdoc facedoc)
+ (when (or fdoc facedoc)
(goto-char (point-min))
(let ((inhibit-read-only t))
(when fdoc
(insert fdoc "\n\n")
- (when facedoc
- (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
+ (when facedoc
+ (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
" is also a " "face." "\n\n")))
(when facedoc
(insert facedoc "\n\n"))
method (cadr item)
args (cddr item))))
(apply method args)
- ;; FIXME: are we sure we're in the right buffer ?
- (goto-char position)))
+ (with-current-buffer buffer
+ (if (get-buffer-window buffer)
+ (set-window-point (get-buffer-window buffer) position)
+ (goto-char position)))))
(defun help-go-back ()
"Invoke the [back] button (if any) in the Help mode buffer."
(provide 'help-mode)
;;; help-mode.el ends here
-
-