;;; help.el --- help commands for XEmacs.
;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 2001 Ben Wing.
;; Maintainer: FSF
;; Keywords: help, internal, dumped
(defvar help-map (let ((map (make-sparse-keymap)))
(set-keymap-name map 'help-map)
(set-keymap-prompt
- map (purecopy (gettext "(Type ? for further options)")))
+ map (gettext "(Type ? for further options)"))
map)
"Keymap for characters following the Help key.")
otherwise it is killed."
(interactive)
(let ((buf (current-buffer)))
- (cond ((frame-property (selected-frame) 'help-window-config)
- (set-window-configuration
- (frame-property (selected-frame) 'help-window-config))
- (set-frame-property (selected-frame) 'help-window-config nil))
+ (cond (help-window-config
+ (set-window-configuration help-window-config))
((not (one-window-p))
(delete-window)))
(if bury
;; This is a grody hack of the same genotype as `advertised-undo'; if the
;; bindings of Backspace and C-h are the same, we want the menubar to claim
-;; that `info' in invoked with `C-h i', not `BS i'.
+;; that `info' is invoked with `C-h i', not `BS i'.
(defun deprecated-help-command ()
(interactive)
;;(define-key global-map 'backspace 'deprecated-help-command)
-;; This function has been moved to help-nomule.el and mule-help.el.
-;; TUTORIAL arg is XEmacs addition
-;(defun help-with-tutorial (&optional tutorial)
-; "Select the XEmacs learn-by-doing tutorial.
-;Optional arg TUTORIAL specifies the tutorial file; default is \"TUTORIAL\"."
-; (interactive)
-; (if (null tutorial)
-; (setq tutorial "TUTORIAL"))
-; (let ((file (expand-file-name (concat "~/" tutorial))))
-; (delete-other-windows)
-; (if (get-file-buffer file)
-; (switch-to-buffer (get-file-buffer file))
-; (switch-to-buffer (create-file-buffer file))
-; (setq buffer-file-name file)
-; (setq default-directory (expand-file-name "~/"))
-; (setq buffer-auto-save-file-name nil)
-; (insert-file-contents (expand-file-name tutorial data-directory))
-; (goto-char (point-min))
-; (search-forward "\n<<")
-; (delete-region (point-at-bol) (point-at-eol))
-; (let ((n (- (window-height (selected-window))
-; (count-lines (point-min) (point))
-; 6)))
-; (if (< n 12)
-; (newline n)
-; ;; Some people get confused by the large gap.
-; (newline (/ n 2))
-; (insert "[Middle of page left blank for didactic purposes. "
-; "Text continues below]")
-; (newline (- n (/ n 2)))))
-; (goto-char (point-min))
-; (set-buffer-modified-p nil))))
+;; help-with-tutorial moved to help-nomule.el and mule-help.el.
;; used by describe-key, describe-key-briefly, insert-key-binding, etc.
-
(defun key-or-menu-binding (key &optional menu-flag)
"Return the command invoked by KEY.
Like `key-binding', but handles menu events and toolbar presses correctly.
KEY is any value returned by `next-command-event'.
MENU-FLAG is a symbol that should be set to t if KEY is a menu event,
- or nil otherwise"
+ or nil otherwise."
(let (defn)
(and menu-flag (set menu-flag nil))
;; If the key typed was really a menu selection, grab the form out
(format "*%s*" name))
(format "*%s*" help-buffer-prefix-string)))
-;; Use this function for displaying help when C-h something is pressed
-;; or in similar situations. Do *not* use it when you are displaying
-;; a help message and then prompting for input in the minibuffer --
-;; this macro usually selects the help buffer, which is not what you
-;; want in those situations.
+;; with-displaying-help-buffer
;; #### Should really be a macro to eliminate the requirement of
;; caller to code a lambda form in THUNK -- mrb
;; another name (which is a shame, because w-d-h-b is a perfect name
;; for a macro) that uses with-displaying-help-buffer internally.
+(defcustom mode-for-help 'help-mode
+ "*Mode that help buffers are put into.")
+
+(defvar help-sticky-window nil
+;; Window into which help buffers will be displayed, rather than
+;; always searching for a new one. This is INTERNAL and liable to
+;; change its interface and/or name at any moment. It should be
+;; bound, not set.
+)
+
+(defvar help-window-config nil)
+
+(make-variable-buffer-local 'help-window-config)
+(put 'help-window-config 'permanent-local t)
+
(defun with-displaying-help-buffer (thunk &optional name)
"Form which makes a help buffer with given NAME and evaluates BODY there.
-The actual name of the buffer is generated by the function `help-buffer-name'."
+The actual name of the buffer is generated by the function `help-buffer-name'.
+
+Use this function for displaying help when C-h something is pressed or
+in similar situations. Do *not* use it when you are displaying a help
+message and then prompting for input in the minibuffer -- this macro
+usually selects the help buffer, which is not what you want in those
+situations."
(let* ((winconfig (current-window-configuration))
(was-one-window (one-window-p))
(buffer-name (help-buffer-name name))
(mapcar 'window-frame
(windows-of-buffer buffer-name)))))))
(help-register-and-maybe-prune-excess buffer-name)
- (prog1 (with-output-to-temp-buffer buffer-name
- (prog1 (funcall thunk)
- (save-excursion
- (set-buffer standard-output)
- (help-mode))))
+ ;; if help-sticky-window is bogus or deleted, get rid of it.
+ (if (and help-sticky-window (or (not (windowp help-sticky-window))
+ (not (window-live-p help-sticky-window))))
+ (setq help-sticky-window nil))
+ (prog1
+ (let ((temp-buffer-show-function
+ (if help-sticky-window
+ #'(lambda (buffer)
+ (set-window-buffer help-sticky-window buffer))
+ temp-buffer-show-function)))
+ (with-output-to-temp-buffer buffer-name
+ (prog1 (funcall thunk)
+ (save-excursion
+ (set-buffer standard-output)
+ (funcall mode-for-help)))))
(let ((helpwin (get-buffer-window buffer-name)))
(when helpwin
- (with-current-buffer (window-buffer helpwin)
- ;; If the *Help* buffer is already displayed on this
- ;; frame, don't override the previous configuration
- (when help-not-visible
- (set-frame-property (selected-frame)
- 'help-window-config winconfig)))
+ ;; If the *Help* buffer is already displayed on this
+ ;; frame, don't override the previous configuration
+ (when help-not-visible
+ (with-current-buffer (window-buffer helpwin)
+ (setq help-window-config winconfig)))
(when help-selects-help-window
(select-window helpwin))
(cond ((eq helpwin (selected-window))
(setq indicator (cdr indicator)))
(while (and indicator (symbolp indicator))
(setq indicator (symbol-value indicator)))
- (princ (format "%s minor mode (indicator%s):\n"
- pretty-minor-mode indicator))
+ (princ (format "%s minor mode (%s):\n"
+ pretty-minor-mode
+ (if indicator
+ (format "indicator%s" indicator)
+ "no indicator")))
(princ (documentation minor-mode))
(princ "\n\n----\n\n"))))
(setq minor-modes (cdr minor-modes)))))
;; So keyboard macro definitions are documented correctly
(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
+;; view a read-only file intelligently
+(defun Help-find-file (file)
+ (if (fboundp 'view-file)
+ (view-file file)
+ (find-file-read-only file)
+ (goto-char (point-min))))
+
(defun describe-distribution ()
"Display info on how to obtain the latest version of XEmacs."
(interactive)
- (find-file-read-only
- (locate-data-file "DISTRIB")))
+ (Help-find-file (locate-data-file "DISTRIB")))
(defun describe-beta ()
"Display info on how to deal with Beta versions of XEmacs."
(interactive)
- (find-file-read-only
- (locate-data-file "BETA"))
- (goto-char (point-min)))
+ (Help-find-file (locate-data-file "BETA")))
(defun describe-copying ()
"Display info on how you may redistribute copies of XEmacs."
(interactive)
- (find-file-read-only
- (locate-data-file "COPYING"))
- (goto-char (point-min)))
+ (Help-find-file (locate-data-file "COPYING")))
(defun describe-pointer ()
"Show a list of all defined mouse buttons, and their definitions."
(defun describe-project ()
"Display info on the GNU project."
(interactive)
- (find-file-read-only
- (locate-data-file "GNU"))
- (goto-char (point-min)))
+ (Help-find-file (locate-data-file "GNU")))
(defun describe-no-warranty ()
"Display info on all the kinds of warranty XEmacs does NOT have."
(defun describe-bindings (&optional prefix mouse-only-p)
"Show a list of all defined keys, and their definitions.
The list is put in a buffer, which is displayed.
-If the optional argument PREFIX is supplied, only commands which
-start with that sequence of keys are described.
-If the second argument (prefix arg, interactively) is non-null
-then only the mouse bindings are displayed."
+If optional first argument PREFIX is supplied, only commands
+which start with that sequence of keys are described.
+If optional second argument MOUSE-ONLY-P (prefix arg, interactively)
+is non-nil then only the mouse bindings are displayed."
(interactive (list nil current-prefix-arg))
(with-displaying-help-buffer
(lambda ()
(stringp Installation-string))
(with-displaying-help-buffer
(lambda ()
- (princ Installation-string))
+ (princ
+ (if (fboundp 'decode-coding-string)
+ (decode-coding-string Installation-string 'automatic-conversion)
+ Installation-string)))
"Installation")
(error "No Installation information available.")))
(defun view-emacs-news ()
"Display info on recent changes to XEmacs."
(interactive)
- (find-file (locate-data-file "NEWS")))
+ (Help-find-file (expand-file-name "NEWS" data-directory)))
(defun xemacs-www-page ()
"Go to the XEmacs World Wide Web page."
(interactive)
- (if (boundp 'browse-url-browser-function)
- (funcall browse-url-browser-function "http://www.xemacs.org/")
+ (if (fboundp 'browse-url)
+ (browse-url "http://www.xemacs.org/")
(error "xemacs-www-page requires browse-url")))
(defun xemacs-www-faq ()
"View the latest and greatest XEmacs FAQ using the World Wide Web."
(interactive)
- (if (boundp 'browse-url-browser-function)
- (funcall browse-url-browser-function
- "http://www.xemacs.org/faq/index.html")
+ (if (fboundp 'browse-url)
+ (browse-url "http://www.xemacs.org/faq/index.html")
(error "xemacs-www-faq requires browse-url")))
(defun xemacs-local-faq ()
(Info-find-node "xemacs-faq" "Top"))
(switch-to-buffer "*info*"))
+(defun view-sample-init-el ()
+ "Display the sample init.el file."
+ (interactive)
+ (Help-find-file (locate-data-file "sample.init.el")))
+
(defcustom view-lossage-key-count 100
"*Number of keys `view-lossage' shows.
The maximum number of available keys is governed by `recent-keys-ring-size'."
help-map)
(defmacro with-syntax-table (syntab &rest body)
- "Evaluate BODY with the syntax-table SYNTAB"
+ "Evaluate BODY with the SYNTAB as the current syntax table."
`(let ((stab (syntax-table)))
(unwind-protect
(progn
(setq obj (read (current-buffer)))
(and (symbolp obj) (fboundp obj) obj)))))))
+(defun function-at-event (event)
+ "Return the function whose name is around the position of EVENT.
+EVENT should be a mouse event. When calling from a popup or context menu,
+use `last-popup-menu-event' to find out where the mouse was clicked.
+\(You cannot use (interactive \"e\"), unfortunately. This returns a
+misc-user event.)
+
+If the event contains no position, or the position is not over text, or
+there is no function around that point, nil is returned."
+ (if (and event (event-buffer event) (event-point event))
+ (save-excursion
+ (set-buffer (event-buffer event))
+ (goto-char (event-point event))
+ (function-at-point))))
+
;; Default to nil for the non-hackers? Not until we find a way to
;; distinguish hackers from non-hackers automatically!
(defcustom describe-function-show-arglist t
(let ((doc (condition-case nil
(or (documentation function)
(gettext "not documented"))
- (void-function ""))))
+ (void-function "(alias for undefined function)")
+ (error "(unexpected error from `documention')"))))
(if (and strip-arglist
(string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc))
(setq doc (substring doc 0 (match-beginning 0))))
doc))
+;; replacement for `princ' that puts the text in the specified face,
+;; if possible
+(defun Help-princ-face (object face)
+ (cond ((bufferp standard-output)
+ (let ((opoint (point standard-output)))
+ (princ object)
+ (put-nonduplicable-text-property opoint (point standard-output)
+ 'face face standard-output)))
+ ((markerp standard-output)
+ (let ((buf (marker-buffer standard-output))
+ (pos (marker-position standard-output)))
+ (princ object)
+ (put-nonduplicable-text-property
+ pos (marker-position standard-output) 'face face buf)))
+ (t (princ object))))
+
+;; replacement for `prin1' that puts the text in the specified face,
+;; if possible
+(defun Help-prin1-face (object face)
+ (cond ((bufferp standard-output)
+ (let ((opoint (point standard-output)))
+ (prin1 object)
+ (put-nonduplicable-text-property opoint (point standard-output)
+ 'face face standard-output)))
+ ((markerp standard-output)
+ (let ((buf (marker-buffer standard-output))
+ (pos (marker-position standard-output)))
+ (prin1 object)
+ (put-nonduplicable-text-property
+ pos (marker-position standard-output) 'face face buf)))
+ (t (prin1 object))))
+
+(defvar help-symbol-regexp
+ (let ((sym-char "[+a-zA-Z0-9_:*]")
+ (sym-char-no-dash "[-+a-zA-Z0-9_:*]"))
+ (concat "\\("
+ ;; a symbol with a - in it.
+ "\\<\\(" sym-char-no-dash "+\\(-" sym-char-no-dash "+\\)+\\)\\>"
+ "\\|"
+ "`\\(" sym-char "+\\)'"
+ "\\)")))
+
+(defun help-symbol-run-function-1 (ev ex fun)
+ (let ((help-sticky-window
+ ;; if we were called from a help buffer, make sure the new help
+ ;; goes in the same window.
+ (if (and (event-buffer ev)
+ (symbol-value-in-buffer 'help-window-config
+ (event-buffer ev)))
+ (event-window ev)
+ help-sticky-window)))
+ (funcall fun (extent-property ex 'help-symbol))))
+
+(defun help-symbol-run-function (fun)
+ (let ((ex (extent-at-event last-popup-menu-event 'help-symbol)))
+ (when ex
+ (help-symbol-run-function-1 last-popup-menu-event ex fun))))
+
+(defvar help-symbol-function-context-menu
+ '(["View %_Documentation" (help-symbol-run-function 'describe-function)]
+ ["Find %_Function Source" (help-symbol-run-function 'find-function)]
+ ["Find %_Tag" (help-symbol-run-function 'find-tag)]
+ ))
+
+(defvar help-symbol-variable-context-menu
+ '(["View %_Documentation" (help-symbol-run-function 'describe-variable)]
+ ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+ ["Find %_Tag" (help-symbol-run-function 'find-tag)]
+ ))
+
+(defvar help-symbol-function-and-variable-context-menu
+ '(["View Function %_Documentation" (help-symbol-run-function
+ 'describe-function)]
+ ["View Variable D%_ocumentation" (help-symbol-run-function
+ 'describe-variable)]
+ ["Find %_Function Source" (help-symbol-run-function 'find-function)]
+ ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+ ["Find %_Tag" (help-symbol-run-function 'find-tag)]
+ ))
+
+(defun frob-help-extents (buffer)
+ ;; Look through BUFFER, starting at the buffer's point and continuing
+ ;; till end of file, and find documented functions and variables.
+ ;; any such symbol found is tagged with an extent, that sets up these
+ ;; properties:
+ ;; 1. mouse-face is 'highlight (so the extent gets highlighted on mouse over)
+ ;; 2. help-symbol is the name of the symbol.
+ ;; 3. face is 'hyper-apropos-hyperlink.
+ ;; 4. context-menu is a list of context menu items, specific to whether
+ ;; the symbol is a function, variable, or both.
+ ;; 5. activate-function will cause the function or variable to be described,
+ ;; replacing the existing help contents.
+ (save-excursion
+ (set-buffer buffer)
+ (let (b e name)
+ (while (re-search-forward help-symbol-regexp nil t)
+ (setq b (or (match-beginning 2) (match-beginning 4)))
+ (setq e (or (match-end 2) (match-end 4)))
+ (setq name (buffer-substring b e))
+ (let* ((sym (intern-soft name))
+ (var (and sym (boundp sym)
+ (documentation-property sym
+ 'variable-documentation t)))
+ (fun (and sym (fboundp sym)
+ (condition-case nil
+ (documentation sym t)
+ (void-function "(alias for undefined function)")
+ (error "(unexpected error from `documention')")))))
+ (when (or var fun)
+ (let ((ex (make-extent b e)))
+ (require 'hyper-apropos)
+ (set-extent-property ex 'mouse-face 'highlight)
+ (set-extent-property ex 'help-symbol sym)
+ (set-extent-property ex 'face 'hyper-apropos-hyperlink)
+ (set-extent-property
+ ex 'context-menu
+ (cond ((and var fun)
+ help-symbol-function-and-variable-context-menu)
+ (var help-symbol-variable-context-menu)
+ (fun help-symbol-function-context-menu)))
+ (set-extent-property
+ ex 'activate-function
+ (if fun
+ #'(lambda (ev ex)
+ (help-symbol-run-function-1 ev ex 'describe-function))
+ #'(lambda (ev ex)
+ (help-symbol-run-function-1 ev ex 'describe-variable))))
+ ))))))) ;; 11 parentheses!
+
(defun describe-function-1 (function &optional nodoc)
"This function does the work for `describe-function'."
- (princ (format "`%s' is " function))
+ (princ "`")
+ ;; (Help-princ-face function 'font-lock-function-name-face) overkill
+ (princ function)
+ (princ "' is ")
(let* ((def function)
aliases file-name autoload-file kbd-macro-p fndef macrop)
(while (and (symbolp def) (fboundp def))
(if describe-function-show-arglist
(let ((arglist (function-arglist function)))
(when arglist
- (princ arglist)
+ (require 'hyper-apropos)
+ (Help-princ-face arglist 'hyper-apropos-documentation)
(terpri))))
(terpri)
(cond (kbd-macro-p
(unless (and obsolete aliases)
(let ((doc (function-documentation function t)))
(princ "Documentation:\n")
- (princ doc)
+ (let ((oldp (point standard-output))
+ newp)
+ (princ doc)
+ (setq newp (point standard-output))
+ (goto-char oldp standard-output)
+ (frob-help-extents standard-output)
+ (goto-char newp standard-output))
(unless (or (equal doc "")
(eq ?\n (aref doc (1- (length doc)))))
(terpri)))))))))
(message nil)
(message (function-arglist function)))
-
(defun variable-at-point ()
(ignore-errors
(with-syntax-table emacs-lisp-mode-syntax-table
(let ((obj (read (current-buffer))))
(and (symbolp obj) (boundp obj) obj))))))
+(defun variable-at-event (event)
+ "Return the variable whose name is around the position of EVENT.
+EVENT should be a mouse event. When calling from a popup or context menu,
+use `last-popup-menu-event' to find out where the mouse was clicked.
+\(You cannot use (interactive \"e\"), unfortunately. This returns a
+misc-user event.)
+
+If the event contains no position, or the position is not over text, or
+there is no variable around that point, nil is returned."
+ (if (and event (event-buffer event) (event-point event))
+ (save-excursion
+ (set-buffer (event-buffer event))
+ (goto-char (event-point event))
+ (variable-at-point))))
+
(defun variable-obsolete-p (variable)
"Return non-nil if VARIABLE is obsolete."
(not (null (get variable 'byte-obsolete-variable))))
(let ((origvar variable)
aliases)
(let ((print-escape-newlines t))
- (princ (format "`%s' is " (symbol-name variable)))
+ (princ "`")
+ ;; (Help-princ-face (symbol-name variable)
+ ;; 'font-lock-variable-name-face) overkill
+ (princ (symbol-name variable))
+ (princ "' is ")
(while (variable-alias variable)
(let ((newvar (variable-alias variable)))
(if aliases
(if file-name
(princ (format " -- loaded from \"%s\"\n" file-name))))
(princ "\nValue: ")
- (if (not (boundp variable))
- (princ "void\n")
- (prin1 (symbol-value variable))
+ (require 'hyper-apropos)
+ (if (not (boundp variable))
+ (Help-princ-face "void\n" 'hyper-apropos-documentation)
+ (Help-prin1-face (symbol-value variable)
+ 'hyper-apropos-documentation)
(terpri))
(terpri)
(cond ((local-variable-p variable (current-buffer))
(when (or (not obsolete) (not aliases))
(if doc
;; note: documentation-property calls substitute-command-keys.
- (princ doc)
+ (let ((oldp (point standard-output))
+ newp)
+ (princ doc)
+ (setq newp (point standard-output))
+ (goto-char oldp standard-output)
+ (frob-help-extents standard-output)
+ (goto-char newp standard-output))
(princ "not documented as a variable."))))
(terpri)))
(format "variable `%s'" variable)))
val)
(setq val (read-command
(if fn (format "Where is command (default %s): " fn)
- "Where is command: ")))
+ "Where is command: ")
+ (and fn (symbol-name fn))))
(list (if (equal (symbol-name val) "")
fn val)
current-prefix-arg)))
(with-displaying-help-buffer
(insert string)))))
-
;;; help.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff