Mercurial > hg > xemacs-beta

comparison lisp/help.el @ 259:11cf20601dec r20-5b28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b28
author cvs
date Mon, 13 Aug 2007 10:23:02 +0200
parents 677f6a0ee643
children 405dd6d1825b
comparison
equal deleted inserted replaced
258:58424f6abf56 259:11cf20601dec
418 This just displays the buffer in another window, rather than selecting 418 This just displays the buffer in another window, rather than selecting
419 the window." 419 the window."
420 :type 'boolean 420 :type 'boolean
421 :group 'help-appearance) 421 :group 'help-appearance)
422 422
423 (defcustom help-max-help-buffers 10
424 "*Maximum help buffers to allow before they start getting killed.
425 If this is a positive integer, before a help buffer is displayed
426 by `with-displaying-help-buffer', any excess help buffers which
427 are not being displayed are first killed. Otherwise, if it is
428 zero or nil, only one help buffer, \"*Help*\" is ever used."
429 :type '(choice integer (const :tag "None" nil))
430 :group 'help-appearance)
431
432 (defvar help-buffer-list nil
433 "List of help buffers used by `help-register-and-maybe-prune-excess'")
434
435 (defun help-register-and-maybe-prune-excess (newbuf)
436 "Register use of a help buffer and possibly kill any excess ones."
437 ;; remove new buffer from list
438 (setq help-buffer-list (remove newbuf help-buffer-list))
439 ;; maybe kill excess help buffers
440 (if (and (integerp help-max-help-buffers)
441 (> (length help-buffer-list) help-max-help-buffers))
442 (let ((keep-list nil)
443 (num-kill (- (length help-buffer-list)
444 help-max-help-buffers)))
445 (while help-buffer-list
446 (let ((buf (car help-buffer-list)))
447 (if (and (or (equal buf newbuf) (get-buffer buf))
448 (string-match "^*Help" buf)
449 (save-excursion (set-buffer buf)
450 (eq major-mode 'help-mode)))
451 (if (and (>= num-kill (length help-buffer-list))
452 (not (get-buffer-window buf t t)))
453 (kill-buffer buf)
454 (setq keep-list (cons buf keep-list)))))
455 (setq help-buffer-list (cdr help-buffer-list)))
456 (setq help-buffer-list (nreverse keep-list))))
457 ;; push new buffer
458 (setq help-buffer-list (cons newbuf help-buffer-list)))
459
423 (defun help-buffer-name (name) 460 (defun help-buffer-name (name)
424 "Return a name for a Help buffer using string NAME for context." 461 "Return a name for a Help buffer using string NAME for context."
425 (if (stringp name) 462 (if (and (integerp help-max-help-buffers)
463 (> help-max-help-buffers 0)
464 (stringp name))
426 (format "*Help: %s*" name) 465 (format "*Help: %s*" name)
427 "*Help*")) 466 "*Help*"))
428 467
429 ;; Use this function for displaying help when C-h something is pressed 468 ;; Use this function for displaying help when C-h something is pressed
430 ;; or in similar situations. Do *not* use it when you are displaying 469 ;; or in similar situations. Do *not* use it when you are displaying
440 (help-not-visible 479 (help-not-visible
441 (not (and (windows-of-buffer buffer-name) ;shortcut 480 (not (and (windows-of-buffer buffer-name) ;shortcut
442 (member (selected-frame) 481 (member (selected-frame)
443 (mapcar 'window-frame 482 (mapcar 'window-frame
444 (windows-of-buffer buffer-name))))))) 483 (windows-of-buffer buffer-name)))))))
445 (if (get-buffer buffer-name) 484 (help-register-and-maybe-prune-excess buffer-name)
446 (kill-buffer buffer-name))
447 (prog1 (with-output-to-temp-buffer buffer-name 485 (prog1 (with-output-to-temp-buffer buffer-name
448 (prog1 ,@body 486 (prog1 ,@body
449 (save-excursion 487 (save-excursion
450 (set-buffer standard-output) 488 (set-buffer standard-output)
451 (help-mode)))) 489 (help-mode))))
1144 OBJECT is printed in the current buffer. Unless it is a list with 1182 OBJECT is printed in the current buffer. Unless it is a list with
1145 more than `help-pretty-print-limit' elements, it is pretty-printed. 1183 more than `help-pretty-print-limit' elements, it is pretty-printed.
1146 1184
1147 Uses `pp-internal' if defined, otherwise `cl-prettyprint'" 1185 Uses `pp-internal' if defined, otherwise `cl-prettyprint'"
1148 (princ 1186 (princ
1149 (if (and (or (listp object) (vectorp object)) 1187 (let ((valstr
1150 (< (length object) 1188 (if (and (or (listp object) (vectorp object))
1151 help-pretty-print-limit)) 1189 (< (length object)
1152 (with-output-to-string 1190 help-pretty-print-limit))
1153 (with-syntax-table emacs-lisp-mode-syntax-table 1191 (with-output-to-string
1154 ;; print `#<...>' values better 1192 (with-syntax-table emacs-lisp-mode-syntax-table
1155 (modify-syntax-entry ?< "(>") 1193 ;; print `#<...>' values better
1156 (modify-syntax-entry ?> ")<") 1194 (modify-syntax-entry ?< "(>")
1157 (let ((indent-line-function 'lisp-indent-line)) 1195 (modify-syntax-entry ?> ")<")
1158 (if (fboundp 'pp-internal) 1196 (let ((indent-line-function 'lisp-indent-line))
1159 (progn 1197 (if (fboundp 'pp-internal)
1160 (pp-internal object "\n") 1198 (progn
1161 (terpri)) 1199 (pp-internal object "\n")
1162 (cl-prettyprint object))))) 1200 (terpri))
1163 (format "\n%S\n" object)))) 1201 (cl-prettyprint object)))))
1202 (format "\n%S\n" object))))
1203
1204 (if (string-match "^\n[^\n]*\n$" valstr)
1205 (substring valstr 1)
1206 valstr))))
1164 1207
1165 (defun describe-variable (variable) 1208 (defun describe-variable (variable)
1166 "Display the full documentation of VARIABLE (a symbol)." 1209 "Display the full documentation of VARIABLE (a symbol)."
1167 (interactive 1210 (interactive
1168 (let* ((v (variable-at-point)) 1211 (let* ((v (variable-at-point))