lisp/help-macro.el

   1 ;;; help-macro.el --- Makes command line help such as help-for-help
   2
   3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
   4
   5 ;; Author: Lynn Slater <lrs@indetech.com>
   6 ;; Created: : Mon Oct  1 11:42:39 1990
   7 ;; Adapted-By: ESR
   8 ;; Last Modified By: Lynn Slater x2048
   9 ;; Last Modified On: Mon Sep 23 14:40:19 1991
  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 2, or (at your option)
  16 ;; 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; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;      This file supplies the macro make-help-screen which constructs
  30 ;; single character dispatching with browsable help such as that provided
  31 ;; by help-for-help. This can be used to make many modes easier to use; for
  32 ;; example, the Gnu Emacs Empire Tool uses this for every "nested" mode map
  33 ;; called from the main mode map.
  34
  35 ;;       The name of this package was changed from help-screen.el to
  36 ;; help-macro.el in order to fit in a 14-character limit.
  37
  38 ;;-> ***********************  Example of use *********************************
  39
  40 ;;->(make-help-screen help-for-empire-redistribute-map
  41 ;;->              "c:civ m:mil p:population f:food ?"
  42 ;;->              "You have discovered the GEET redistribution commands
  43 ;;->   From here, you can use the following options:
  44 ;;->
  45 ;;->c   Redistribute civs from overfull sectors into connected underfull ones
  46 ;;->      The functions typically named by empire-ideal-civ-fcn control
  47 ;;->          based in part on empire-sector-civ-threshold
  48 ;;->m   Redistribute military using levels given by empire-ideal-mil-fcn
  49 ;;->p   Redistribute excess population to highways for max pop growth
  50 ;;->      Excess is any sector so full babies will not be born.
  51 ;;->f   Even out food on highways to highway min and leave levels
  52 ;;->      This is good to pump max food to all warehouses/dist pts
  53 ;;->
  54 ;;->
  55 ;;->Use \\[help-for-empire-redistribute-map] for help on redistribution.
  56 ;;->Use \\[help-for-empire-extract-map] for help on data extraction.
  57 ;;->Please use \\[describe-key] to find out more about any of the other keys."
  58 ;;->              empire-shell-redistribute-map)
  59
  60 ;;->  (define-key c-mp "\C-h" 'help-for-empire-redistribute-map)
  61 ;;->  (define-key c-mp help-character 'help-for-empire-redistribute-map)
  62
  63 ;;; Change Log:
  64 ;;
  65 ;; 22-Jan-1991          Lynn Slater x2048
  66 ;;    Last Modified: Mon Oct  1 11:43:52 1990 #3 (Lynn Slater)
  67 ;;    documented better
  68
  69 ;;; Code:
  70
  71 (provide 'help-macro)
  72 (require 'backquote)
  73
  74 (defmacro make-help-screen (fname help-line help-text helped-map)
  75   "Construct help-menu function name FNAME.
  76 When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP.
  77 If the command is the help character is requested, FNAME displays HELP-TEXT
  78 and continues trying to read a command using HELPED-MAP.
  79 When FNAME finally does get a command, it executes that command
  80 and then returns."
  81   (` (defun (, fname) ()
  82            (, help-text)
  83            (interactive)
  84            (let ((line-prompt
  85                   (substitute-command-keys (, help-line))))
  86              (message line-prompt)
  87              (let* ((overriding-local-map (make-sparse-keymap))
  88                     (minor-mode-map-alist nil)
  89                     config key char help-screen)
  90                (unwind-protect
  91                    (progn
  92                      (setcdr overriding-local-map (, helped-map))
  93                      (define-key overriding-local-map [t] 'undefined)
  94                      (setq help-screen (documentation (quote (, fname))))
  95                      (setq key (read-key-sequence nil))
  96                      (setq char (aref key 0))
  97                      (if (or (eq char ??) (eq char help-char))
  98                          (progn
  99                            (setq config (current-window-configuration))
 100                            (switch-to-buffer-other-window "*Help*")
 101                            (erase-buffer)
 102                            (insert help-screen)
 103                            (goto-char (point-min))
 104                            (while (or (memq char (cons help-char '(?? ?\C-v ?\ ?\177 ?\M-v)))
 105                                       (equal key "\M-v"))
 106                              (setq list (cons key list))
 107                              (condition-case nil
 108                                  (progn
 109                                    (if (memq char '(?\C-v ?\ ))
 110                                        (scroll-up))
 111                                    (if (or (memq char '(?\177 ?\M-v))
 112                                            (equal key "\M-v"))
 113                                        (scroll-down)))
 114                                (error nil))
 115                              (message "%s%s: "
 116                                       line-prompt
 117                                       (if (pos-visible-in-window-p (point-max))
 118                                           "" " or Space to scroll"))
 119                              (let ((cursor-in-echo-area t))
 120                                (setq key (read-key-sequence nil)
 121                                      char (aref key 0))))
 122                            (setq list (cons key list))))
 123                      ;; Mouse clicks are not part of the help feature,
 124                      ;; so reexecute them in the standard environment.
 125                      (if (listp char)
 126                          (setq unread-command-events
 127                                (cons char unread-command-events)
 128                                config nil)
 129                        (let ((defn (key-binding key)))
 130                          (if defn
 131                              (progn
 132                                (if config
 133                                    (progn
 134                                      (set-window-configuration config)
 135                                      (setq config nil)))
 136                                (setq overriding-local-map nil)
 137                                (call-interactively defn))
 138                            (ding)))))
 139                  (if config
 140                      (set-window-configuration config))))))
 141      ))
 142
 143 ;;; help-macro.el
 144