Mercurial > hg > xemacs-beta
annotate lisp/help-macro.el @ 5885:c8bbb32fe124
Always return a string, #'current-message.
lisp/ChangeLog addition:
2015-04-04 Aidan Kehoe <kehoea@parhasard.net>
* gutter-items.el (append-progress-feedback):
* gutter-items.el (abort-progress-feedback):
Correct comments in both these functions, it's the progress stack
being adjusted, not the message stack.
* simple.el (message-stack):
Describe my recent change in the structure of this.
* simple.el (current-message):
Adjust the implementation of this to always return the string
displayed.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 04 Apr 2015 13:49:30 +0100 |
| parents | 3bc58dc9d688 |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; help-macro.el --- Makes command line help such as help-for-help |
| 2 | |
| 3 ;; Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Lynn Slater <lrs@indetech.com> | |
| 6 ;; Maintainer: FSF | |
| 7 ;; Created: : Mon Oct 1 11:42:39 1990 | |
| 8 ;; Adapted-By: ESR | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
15 ;; option) any later version. |
| 428 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
2275
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;;; Synched up with: FSF 20.2. | |
| 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 ;;; Code: | |
| 64 | |
| 65 (provide 'help-macro) | |
| 66 | |
| 67 ;;;###autoload | |
| 68 (defcustom three-step-help t | |
| 69 "*Non-nil means give more info about Help command in three steps. | |
| 70 The three steps are simple prompt, prompt with all options, | |
| 71 and window listing and describing the options. | |
| 72 A value of nil means skip the middle step, so that | |
| 73 \\[help-command] \\[help-command] gives the window that lists the options." | |
| 74 :type 'boolean | |
| 75 :group 'help-appearance) | |
| 76 | |
| 77 (defmacro make-help-screen (fname help-line help-text helped-map) | |
| 78 "Construct help-menu function name FNAME. | |
| 502 | 79 When invoked, FNAME shows HELP-LINE and reads a command using |
| 80 HELPED-MAP. If the command is the help character, FNAME displays | |
| 81 HELP-TEXT and continues trying to read a command using HELPED-MAP. | |
| 82 When FNAME finally does get a command, it executes that command and | |
| 83 then returns. As of 21.5 (or 21.4?), HELP-LINE and HELP-TEXT are | |
| 84 `eval'd, just like for a function call. This allows you to place | |
| 85 Lisp expressions in those arguments." | |
| 428 | 86 `(defun ,fname () |
| 502 | 87 ,(eval help-text) |
| 428 | 88 (interactive) |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
89 (labels |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
90 ((help-read-key (prompt) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
91 ;; This is in `labels' to avoid problems with autoloading. |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
92 ;; #### The function is ill-conceived -- there should be |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
93 ;; a way to do it without all the hassle! |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
94 (let (events) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
95 (while (not (key-press-event-p |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
96 (aref (setq events (read-key-sequence prompt)) 0))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
97 ;; Mouse clicks are not part of the help feature, so |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
98 ;; reexecute them in the standard environment. |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
99 (mapc 'dispatch-event events)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
100 (let ((key (nconc (event-modifiers (aref events 0)) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
101 (list (event-key (aref events 0)))))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
102 ;; Make the HELP key translate to C-h. |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
103 (when (lookup-key function-key-map key) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
104 (setq key (lookup-key function-key-map key))) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
105 (if (eq (length key) 1) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
106 (car key) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
107 key))))) |
| 428 | 108 (let ((line-prompt |
| 502 | 109 (substitute-command-keys ,(eval help-line)))) |
| 428 | 110 (when three-step-help |
| 111 (message "%s" line-prompt)) | |
| 2275 | 112 (let* ((help-screen |
| 113 (condition-case nil | |
| 114 (documentation (quote ,fname)) | |
| 115 (void-function "(alias for undefined function)") | |
| 116 (error "(unexpected error from `documention')"))) | |
| 428 | 117 ;; We bind overriding-local-map for very small |
| 118 ;; sections, *excluding* where we switch buffers and | |
| 119 ;; where we execute the chosen help command. | |
| 120 (local-map (make-sparse-keymap)) | |
| 121 (minor-mode-map-alist nil) | |
| 122 (prev-frame (selected-frame)) | |
| 123 config new-frame key) | |
| 124 (unwind-protect | |
| 125 (progn | |
| 126 (set-keymap-parents local-map (list ,helped-map)) | |
| 127 (cond (three-step-help | |
| 128 (let* ((overriding-local-map local-map)) | |
| 129 (setq key (help-read-key nil)))) | |
| 130 (t | |
| 131 (setq key ??))) | |
| 132 (when (or (equal key ??) | |
| 133 (equal key (list help-char))) | |
| 134 (setq config (current-window-configuration)) | |
| 135 (switch-to-buffer-other-window "*Help*") | |
| 136 (and (not (eq (window-frame (selected-window)) | |
| 137 prev-frame)) | |
| 138 (setq new-frame (window-frame (selected-window)) | |
| 139 config nil)) | |
| 140 (setq buffer-read-only nil) | |
| 141 (erase-buffer) | |
| 142 (insert help-screen) | |
| 143 (help-mode) | |
| 144 (goto-char (point-min)) | |
| 145 (while (member key `((,help-char) ?? (control v) space ?\177 | |
| 146 delete backspace (meta v))) | |
| 147 (ignore-errors | |
| 148 (cond ((member key '((control v) space)) | |
| 149 (scroll-up)) | |
| 150 ((member key '(?\177 delete (meta v) backspace)) | |
| 151 (scroll-down)))) | |
| 152 (let ((cursor-in-echo-area t) | |
| 153 (overriding-local-map local-map)) | |
| 154 (setq key (help-read-key | |
| 155 (format "Type one of the options listed%s: " | |
| 156 (if (pos-visible-in-window-p | |
| 157 (point-max)) | |
| 158 "" " or Space to scroll"))))))) | |
| 159 ;; We don't need the prompt any more. | |
| 160 (message nil) | |
| 161 (let ((defn (lookup-key local-map key))) | |
| 162 (cond (defn | |
| 163 (when config | |
| 164 (set-window-configuration config) | |
| 165 (setq config nil)) | |
| 166 (when new-frame | |
| 167 (iconify-frame new-frame) | |
| 168 (setq new-frame nil)) | |
| 169 (call-interactively defn)) | |
| 170 (t | |
| 171 (ding))))) | |
| 172 (and (get-buffer "*Help*") | |
| 173 (bury-buffer "*Help*")) | |
| 174 (and new-frame (iconify-frame new-frame)) | |
| 175 (and config | |
| 176 (set-window-configuration config)))))))) | |
| 177 | |
| 178 ;;; help-macro.el | |
| 179 |