(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)))))
(defun view-emacs-news ()
"Display info on recent changes to XEmacs."
(interactive)
- (Help-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."
(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)))
+ (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)))
+ (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_:*]")
;; 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 'font-lock-reference-face.
+ ;; 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,
(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 'font-lock-reference-face)
+ (set-extent-property ex 'face 'hyper-apropos-hyperlink)
(set-extent-property
ex 'context-menu
(cond ((and var fun)
(if describe-function-show-arglist
(let ((arglist (function-arglist function)))
(when arglist
- (Help-princ-face arglist 'font-lock-comment-face)
+ (require 'hyper-apropos)
+ (Help-princ-face arglist 'hyper-apropos-documentation)
(terpri))))
(terpri)
(cond (kbd-macro-p
(let ((print-escape-newlines t))
(princ "`")
;; (Help-princ-face (symbol-name variable)
- ;; 'font-lock-variable-name-face) overkill
+ ;; 'font-lock-variable-name-face) overkill
(princ (symbol-name variable))
(princ "' is ")
(while (variable-alias variable)
(if file-name
(princ (format " -- loaded from \"%s\"\n" file-name))))
(princ "\nValue: ")
- (if (not (boundp variable))
- (Help-princ-face "void\n" 'font-lock-comment-face)
- (Help-prin1-face (symbol-value variable) 'font-lock-comment-face)
+ (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))
projects / chise / xemacs-chise.git.1 / blobdiff