X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fhelp.el;h=1ac1780dec349a3db3bbb5c14efa3726c2eb06a8;hb=32027556503327b621d57ad57d5d7405dec8f7ea;hp=e7e769f71f11c414e5658cb966aac205fbe0363f;hpb=3062d425fac0473eb5aa2efc0bb002f6ce0cb028;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/help.el b/lisp/help.el index e7e769f..1ac1780 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -433,11 +433,7 @@ You should never set this directory, only let-bind it.") (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 @@ -464,7 +460,13 @@ You should never set this directory, only let-bind it.") (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)) @@ -579,8 +581,11 @@ describes the minor mode." (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))))) @@ -731,7 +736,7 @@ of the key sequence that ran this command." (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." @@ -1070,65 +1075,44 @@ part of the documentation of internal subroutines." (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_:*]") @@ -1185,7 +1169,7 @@ part of the documentation of internal subroutines." ;; 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, @@ -1202,12 +1186,16 @@ part of the documentation of internal subroutines." (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) @@ -1292,7 +1280,8 @@ part of the documentation of internal subroutines." (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 @@ -1434,7 +1423,7 @@ there is no variable around that point, nil is returned." (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) @@ -1457,9 +1446,11 @@ there is no variable around that point, nil is returned." (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))