;;; 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
;; 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.
(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
(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))
(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 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."
(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'."
(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))
-; (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)))
+
+;; 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_:*]")
(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)]
+ '(["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)]
+ '(["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
+ '(["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)
;; 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
+ ;; 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.
- ;; 4. activate-function will cause the function or variable to be described,
+ ;; 5. activate-function will cause the function or variable to be described,
;; replacing the existing help contents.
(save-excursion
(set-buffer buffer)
(documentation-property sym
'variable-documentation t)))
(fun (and sym (fboundp sym)
- (documentation sym t))))
+ (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)
(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
(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))
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)))
projects / chise / xemacs-chise.git.1 / blobdiff