/[emacs]/emacs/lisp/help.el
ViewVC logotype

Diff of /emacs/lisp/help.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.250 by rms, Wed May 1 16:40:39 2002 UTC revision 1.250.2.1 by miles, Fri Apr 4 06:20:06 2003 UTC
# Line 98  Line 98 
98  (autoload 'finder-by-keyword "finder"  (autoload 'finder-by-keyword "finder"
99    "Find packages matching a given keyword." t)    "Find packages matching a given keyword." t)
100    
101    (define-key help-map "r" 'info-emacs-manual)
102    
103  (define-key help-map "s" 'describe-syntax)  (define-key help-map "s" 'describe-syntax)
104    
105  (define-key help-map "t" 'help-with-tutorial)  (define-key help-map "t" 'help-with-tutorial)
# Line 123  This is a list Line 125  This is a list
125    
126  (defun print-help-return-message (&optional function)  (defun print-help-return-message (&optional function)
127    "Display or return message saying how to restore windows after help command.    "Display or return message saying how to restore windows after help command.
128  Computes a message and applies the optional argument FUNCTION to it.  This function assumes that `standard-output' is the help buffer.
129  If FUNCTION is nil, applies `message' to it, thus printing it."  It computes a message, and applies the optional argument FUNCTION to it.
130    If FUNCTION is nil, it applies `message', thus displaying the message."
131    (and (not (get-buffer-window standard-output))    (and (not (get-buffer-window standard-output))
132         (let ((first-message         (let ((first-message
133                (cond ((special-display-p (buffer-name standard-output))                (cond ((special-display-p (buffer-name standard-output))
# Line 410  If INSERT (the prefix arg) is non-nil, i Line 413  If INSERT (the prefix arg) is non-nil, i
413     (let ((fn (function-called-at-point))     (let ((fn (function-called-at-point))
414           (enable-recursive-minibuffers t)           (enable-recursive-minibuffers t)
415           val)           val)
416       (setq val (completing-read (if fn       (setq val (completing-read
417                                      (format "Where is command (default %s): " fn)                  (if fn
418                                    "Where is command: ")                      (format "Where is command (default %s): " fn)
419                                  obarray 'commandp t))                    "Where is command: ")
420       (list (if (equal val "")                  obarray 'commandp t))
421                 fn (intern val))       (list (if (equal val "") fn (intern val)) current-prefix-arg)))
422             current-prefix-arg)))    (let ((func (indirect-function definition))
423    (let* ((remapped (remap-command definition))          (defs nil)
424           (keys (where-is-internal definition overriding-local-map nil nil remapped))          (standard-output (if insert (current-buffer) t)))
425           (keys1 (mapconcat 'key-description keys ", "))      (mapatoms (lambda (symbol)
426           (standard-output (if insert (current-buffer) t)))                  (and (fboundp symbol)
427      (if insert                       (not (eq symbol definition))
428          (if (> (length keys1) 0)                       (eq func (condition-case ()
429              (if remapped                                    (indirect-function symbol)
430                  (princ (format "%s (%s) (remapped from %s)" keys1 remapped definition))                                  (error symbol)))
431                (princ (format "%s (%s)" keys1 definition)))                       (push symbol defs))))
432            (princ (format "M-x %s RET" definition)))      (princ (mapconcat
433        (if (> (length keys1) 0)              #'(lambda (symbol)
434            (if remapped                  (let* ((remapped (command-remapping symbol))
435                (princ (format "%s is remapped to %s which is on %s" definition remapped keys1))                         (keys (where-is-internal
436              (princ (format "%s is on %s" definition keys1)))                                symbol overriding-local-map nil nil remapped))
437          (princ (format "%s is not on any key" definition)))))                         (keys (mapconcat 'key-description keys ", ")))
438                      (if insert
439                          (if (> (length keys) 0)
440                              (if remapped
441                                  (format "%s (%s) (remapped from %s)"
442                                          keys remapped symbol)
443                                (format "%s (%s)" keys symbol))
444                            (format "M-x %s RET" symbol))
445                        (if (> (length keys) 0)
446                            (if remapped
447                                (format "%s is remapped to %s which is on %s"
448                                        definition symbol keys)
449                              (format "%s is on %s" symbol keys))
450                          (format "%s is not on any key" symbol)))))
451                (cons definition defs)
452                ";\nand ")))
453    nil)    nil)
454    
455  (defun string-key-binding (key)  (defun string-key-binding (key)
# Line 458  or `keymap' property, return the binding Line 476  or `keymap' property, return the binding
476    
477  (defun help-key-description (key untranslated)  (defun help-key-description (key untranslated)
478    (let ((string (key-description key)))    (let ((string (key-description key)))
479      (if (or (not untranslated) (eq (aref untranslated 0) ?\e))      (if (or (not untranslated)
480                (and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
481          string          string
482        (let ((otherstring (key-description untranslated)))        (let ((otherstring (key-description untranslated)))
483          (if (equal string otherstring)          (if (equal string otherstring)
484              string              string
485            (format "%s (translated from %s)" string otherstring))))))            (format "%s (translated from %s)" string otherstring))))))
486              
487  (defun describe-key-briefly (key &optional insert untranslated)  (defun describe-key-briefly (key &optional insert untranslated)
488    "Print the name of the function KEY invokes.  KEY is a string.    "Print the name of the function KEY invokes.  KEY is a string.
489  If INSERT (the prefix arg) is non-nil, insert the message in the buffer.  If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
# Line 592  For minor modes, see following pages.\n\ Line 611  For minor modes, see following pages.\n\
611            (setq minor-modes (cdr minor-modes))))            (setq minor-modes (cdr minor-modes))))
612        (print-help-return-message))))        (print-help-return-message))))
613    
614    (defun describe-minor-mode (minor-mode)
615      "Display documentation of a minor mode given as MINOR-MODE."
616      (interactive (list (intern (completing-read
617                                  "Minor mode: "
618                                  (delete nil (mapcar
619                                               (function (lambda (x)
620                                                           (if (eval (car x))
621                                                               (symbol-name (car x)))))
622                                               minor-mode-alist))))))
623      (if (fboundp minor-mode)
624          (describe-function minor-mode)
625        (describe-variable minor-mode)))
626    
627    (defun describe-minor-mode-from-indicator (indicator)
628      "Display documentation of a minor mode specified by INDICATOR."
629      (interactive (list
630                    (completing-read
631                     "Minor mode indicator: "
632                     (delete nil
633                             (mapcar
634                              #'(lambda (x)
635                                  (if (eval (car x))
636                                      (let ((i (expand-minor-mode-indicator-object (cadr x))))
637                                        (if (and (< 0 (length i))
638                                                 (string= " " (substring i 0 1)))
639                                            (substring i 1)
640                                          i))))
641                              minor-mode-alist)))))
642      (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
643        (if minor-mode
644            (describe-minor-mode minor-mode)
645          (error "Cannot find minor mode for `%s'" indicator))))
646    
647    (defun lookup-minor-mode-from-indicator (indicator)
648      "Return a minor mode symbol from its indicator on the modeline."
649      (if (and (< 0 (length indicator))
650               (not (string= " " (substring indicator 0 1))))
651          (setq indicator (concat " " indicator)))
652      (let ((minor-modes minor-mode-alist)
653            result)
654        (while minor-modes
655          (let* ((minor-mode (car (car minor-modes)))
656                 (anindicator (car (cdr (car minor-modes)))))
657            (setq anindicator (expand-minor-mode-indicator-object anindicator))
658            (if (and (stringp anindicator)
659                     (string= anindicator indicator))
660                (setq result minor-mode
661                      minor-modes nil)
662              (setq minor-modes (cdr minor-modes)))))
663        result))
664    
665    (defun expand-minor-mode-indicator-object (obj)
666      "Expand OBJ that represents a minor-mode indicator.
667    cdr part of a `minor-mode-alist' element(indicator object) is the
668    indicator of minor mode that is in car part.  Normally indicator
669    object is a string. However, in some case it is more compound object
670    like cons cell. This function tries to make the compound object a string."
671      ;; copied from describe-mode
672      (while (and obj (symbolp obj)
673                  (boundp obj)
674                  (not (eq obj (symbol-value obj))))
675        (setq obj (symbol-value obj)))
676      (when (and (consp obj)
677                 (keywordp (car obj))
678                 (eq :eval (car obj)))
679        (setq obj (eval (cadr obj))))
680      obj)
681    
682    
683  ;;; Automatic resizing of temporary buffers.  ;;; Automatic resizing of temporary buffers.
684    

Legend:
Removed from v.1.250  
changed lines
  Added in v.1.250.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26