(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
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
;; 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'."
(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))
(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 ()
(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 ()
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
(string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc))
(setq doc (substring doc 0 (match-beginning 0))))
doc))
+; (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]"))
+; (list
+; ;;
+; ;; The symbol itself.
+; (list (concat "\\`\\(" name-char "+\\)\\(:\\)?")
+; '(1 (if (match-beginning 2)
+; 'font-lock-function-name-face
+; 'font-lock-variable-name-face)
+; nil t))
+; ;;
+; ;; Words inside `' which tend to be symbol names.
+; (list (concat "`\\(" sym-char sym-char "+\\)'")
+; 1 '(prog1
+; 'font-lock-reference-face
+; (add-list-mode-item (match-beginning 1)
+; (match-end 1)
+; nil
+; 'help-follow-reference))
+; t)
+; ;;
+; ;; CLisp `:' keywords as references.
+; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t)))
+
+(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)]
+ ))
+
+(defvar help-symbol-variable-context-menu
+ '("---"
+ ["View %_Documentation" (help-symbol-run-function 'describe-variable)]
+ ["Find %_Variable Source" (help-symbol-run-function 'find-variable)]
+ ))
+
+(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)]
+ ))
+
+(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. context-menu is a list of context menu items, specific to whether
+ ;; the symbol is a function, variable, or both.
+ ;; 4. 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)
+ (documentation sym t))))
+ (when (or var fun)
+ (let ((ex (make-extent b e)))
+ (set-extent-property ex 'mouse-face 'highlight)
+ (set-extent-property ex 'help-symbol sym)
+ (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'."
(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))))
(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)))
(with-displaying-help-buffer
(insert string)))))
-
;;; help.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff