LCOV - code coverage report
Current view: top level - lisp - help-macro.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 8 8 100.0 %
Date: 2017-08-30 10:12:24 Functions: 1 1 100.0 %

          Line data    Source code
       1             : ;;; help-macro.el --- makes command line help such as help-for-help
       2             : 
       3             : ;; Copyright (C) 1993-1994, 2001-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Lynn Slater <lrs@indetech.com>
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Created: Mon Oct  1 11:42:39 1990
       8             : ;; Adapted-By: ESR
       9             : ;; Package: emacs
      10             : 
      11             : ;; This file is part of GNU Emacs.
      12             : 
      13             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      14             : ;; it under the terms of the GNU General Public License as published by
      15             : ;; the Free Software Foundation, either version 3 of the License, or
      16             : ;; (at your option) any later version.
      17             : 
      18             : ;; GNU Emacs is distributed in the hope that it will be useful,
      19             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      20             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      21             : ;; GNU General Public License for more details.
      22             : 
      23             : ;; You should have received a copy of the GNU General Public License
      24             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      25             : 
      26             : ;;; Commentary:
      27             : 
      28             : ;; This file supplies the macro make-help-screen which constructs
      29             : ;; single character dispatching with browsable help such as that provided
      30             : ;; by help-for-help. This can be used to make many modes easier to use; for
      31             : ;; example, the GNU Emacs Empire Tool uses this for every "nested" mode map
      32             : ;; called from the main mode map.
      33             : 
      34             : ;;       The name of this package was changed from help-screen.el to
      35             : ;; help-macro.el in order to fit in a 14-character limit.
      36             : 
      37             : ;;-> ***********************  Example of use *********************************
      38             : 
      39             : ;;->(make-help-screen help-for-empire-redistribute-map
      40             : ;;->           "c:civ m:mil p:population f:food ?"
      41             : ;;->           "You have discovered the GEET redistribution commands
      42             : ;;->   From here, you can use the following options:
      43             : ;;->
      44             : ;;->c        Redistribute civs from overfull sectors into connected underfull ones
      45             : ;;->   The functions typically named by empire-ideal-civ-fcn control
      46             : ;;->          based in part on empire-sector-civ-threshold
      47             : ;;->m        Redistribute military using levels given by empire-ideal-mil-fcn
      48             : ;;->p        Redistribute excess population to highways for max pop growth
      49             : ;;->   Excess is any sector so full babies will not be born.
      50             : ;;->f        Even out food on highways to highway min and leave levels
      51             : ;;->   This is good to pump max food to all warehouses/dist pts
      52             : ;;->
      53             : ;;->
      54             : ;;->Use \\[help-for-empire-redistribute-map] for help on redistribution.
      55             : ;;->Use \\[help-for-empire-extract-map] for help on data extraction.
      56             : ;;->Please use \\[describe-key] to find out more about any of the other keys."
      57             : ;;->           empire-shell-redistribute-map)
      58             : 
      59             : ;;->  (define-key c-mp "\C-h" 'help-for-empire-redistribute-map)
      60             : ;;->  (define-key c-mp help-character 'help-for-empire-redistribute-map)
      61             : 
      62             : ;;; Change Log:
      63             : ;;
      64             : ;; 22-Jan-1991          Lynn Slater x2048
      65             : ;;    Last Modified: Mon Oct  1 11:43:52 1990 #3 (Lynn Slater)
      66             : ;;    documented better
      67             : 
      68             : ;;; Code:
      69             : 
      70             : (require 'backquote)
      71             : 
      72             : ;; This needs to be autoloaded because it is used in the
      73             : ;; make-help-screen macro.  Using (bound-and-true-p three-step-help)
      74             : ;; is not an acceptable alternative, because nothing loads help-macro
      75             : ;; in a normal session, so any user customization would never be applied.
      76             : ;;;###autoload
      77             : (defcustom three-step-help nil
      78             :   "Non-nil means give more info about Help command in three steps.
      79             : The three steps are simple prompt, prompt with all options, and
      80             : window listing and describing the options.
      81             : A value of nil means skip the middle step, so that \\[help-command] \\[help-command]
      82             : gives the window that lists the options."
      83             :   :type 'boolean
      84             :   :group 'help)
      85             : 
      86             : (defmacro make-help-screen (fname help-line help-text helped-map)
      87             :   "Construct help-menu function name FNAME.
      88             : When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP.
      89             : If the command is the help character, FNAME displays HELP-TEXT
      90             : and continues trying to read a command using HELPED-MAP.
      91             : If HELP-TEXT contains the sequence `%THIS-KEY%', that is replaced
      92             : with the key sequence that invoked FNAME.
      93             : When FNAME finally does get a command, it executes that command
      94             : and then returns."
      95           1 :   (let ((doc-fn (intern (concat (symbol-name fname) "-doc"))))
      96           1 :     `(progn
      97           1 :        (defun ,doc-fn () ,help-text nil)
      98           1 :        (defun ,fname ()
      99             :          "Help command."
     100             :          (interactive)
     101             :          (let ((line-prompt
     102           1 :                 (substitute-command-keys ,help-line)))
     103             :            (when three-step-help
     104             :              (message "%s" line-prompt))
     105           1 :            (let* ((help-screen (documentation (quote ,doc-fn)))
     106             :                   ;; We bind overriding-local-map for very small
     107             :                   ;; sections, *excluding* where we switch buffers
     108             :                   ;; and where we execute the chosen help command.
     109             :                   (local-map (make-sparse-keymap))
     110             :                   (new-minor-mode-map-alist minor-mode-map-alist)
     111             :                   (prev-frame (selected-frame))
     112             :                   config new-frame key char)
     113             :              (when (string-match "%THIS-KEY%" help-screen)
     114             :                (setq help-screen
     115             :                      (replace-match (key-description
     116             :                                      (substring (this-command-keys) 0 -1))
     117             :                                     t t help-screen)))
     118             :              (unwind-protect
     119             :                  (let ((minor-mode-map-alist nil))
     120           1 :                    (setcdr local-map ,helped-map)
     121             :                    (define-key local-map [t] 'undefined)
     122             :                    ;; Make the scroll bar keep working normally.
     123             :                    (define-key local-map [vertical-scroll-bar]
     124             :                      (lookup-key global-map [vertical-scroll-bar]))
     125             :                    (if three-step-help
     126             :                        (progn
     127             :                          (setq key (let ((overriding-local-map local-map))
     128             :                                      (read-key-sequence nil)))
     129             :                          ;; Make the HELP key translate to C-h.
     130             :                          (if (lookup-key function-key-map key)
     131             :                              (setq key (lookup-key function-key-map key)))
     132             :                          (setq char (aref key 0)))
     133             :                      (setq char ??))
     134             :                    (when (or (eq char ??) (eq char help-char)
     135             :                              (memq char help-event-list))
     136             :                      (setq config (current-window-configuration))
     137             :                      (pop-to-buffer " *Metahelp*" nil t)
     138             :                      (and (fboundp 'make-frame)
     139             :                           (not (eq (window-frame)
     140             :                                    prev-frame))
     141             :                           (setq new-frame (window-frame)
     142             :                                 config nil))
     143             :                      (setq buffer-read-only nil)
     144             :                      (let ((inhibit-read-only t))
     145             :                        (erase-buffer)
     146             :                        (insert help-screen))
     147             :                      (let ((minor-mode-map-alist new-minor-mode-map-alist))
     148             :                        (help-mode)
     149             :                        (setq new-minor-mode-map-alist minor-mode-map-alist))
     150             :                      (goto-char (point-min))
     151             :                      (while (or (memq char (append help-event-list
     152             :                                                    (cons help-char '(?? ?\C-v ?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
     153             :                                 (eq (car-safe char) 'switch-frame)
     154             :                                 (equal key "\M-v"))
     155             :                        (condition-case nil
     156             :                            (cond
     157             :                             ((eq (car-safe char) 'switch-frame)
     158             :                              (handle-switch-frame char))
     159             :                             ((memq char '(?\C-v ?\s))
     160             :                              (scroll-up))
     161             :                             ((or (memq char '(?\177 ?\M-v delete backspace))
     162             :                                  (equal key "\M-v"))
     163             :                              (scroll-down)))
     164             :                          (error nil))
     165             :                        (let ((cursor-in-echo-area t)
     166             :                              (overriding-local-map local-map))
     167             :                          (setq key (read-key-sequence
     168             :                                     (format "Type one of the options listed%s: "
     169             :                                             (if (pos-visible-in-window-p
     170             :                                                  (point-max))
     171             :                                                 "" ", or SPACE or DEL to scroll")))
     172             :                                char (aref key 0)))
     173             : 
     174             :                        ;; If this is a scroll bar command, just run it.
     175             :                        (when (eq char 'vertical-scroll-bar)
     176             :                          (command-execute (lookup-key local-map key) nil key))))
     177             :                    ;; We don't need the prompt any more.
     178             :                    (message "")
     179             :                    ;; Mouse clicks are not part of the help feature,
     180             :                    ;; so reexecute them in the standard environment.
     181             :                    (if (listp char)
     182             :                        (setq unread-command-events
     183             :                              (cons char unread-command-events)
     184             :                              config nil)
     185             :                      (let ((defn (lookup-key local-map key)))
     186             :                        (if defn
     187             :                            (progn
     188             :                              (when config
     189             :                                (set-window-configuration config)
     190             :                                (setq config nil))
     191             :                              ;; Temporarily rebind `minor-mode-map-alist'
     192             :                              ;; to `new-minor-mode-map-alist' (Bug#10454).
     193             :                              (let ((minor-mode-map-alist new-minor-mode-map-alist))
     194             :                                ;; `defn' must make sure that its frame is
     195             :                                ;; selected, so we won't iconify it below.
     196             :                                (call-interactively defn))
     197             :                              (when new-frame
     198             :                                ;; Do not iconify the selected frame.
     199             :                                (unless (eq new-frame (selected-frame))
     200             :                                  (iconify-frame new-frame))
     201             :                                (setq new-frame nil)))
     202             :                          (ding)))))
     203             :                (when config
     204             :                  (set-window-configuration config))
     205             :                (when new-frame
     206             :                  (iconify-frame new-frame))
     207           1 :                (setq minor-mode-map-alist new-minor-mode-map-alist))))))))
     208             : 
     209             : (provide 'help-macro)
     210             : 
     211             : ;;; help-macro.el ends here

Generated by: LCOV version 1.12