Mercurial > emacs
comparison lisp/wid-edit.el @ 18461:35976f73432d
(widget-choice-action): Use widget-edit-functions.
(widget-toggle-action): Likewise.
(widget-choose): Use only digits, except for C-g.
Allocate digits to disabled commands too.
Don't use a keyboard menu; instead, display a buffer
listing all the alternatives. Put cursor in echo area.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 27 Jun 1997 06:04:19 +0000 |
parents | 8eb08560287b |
children | e22e2a4e683a |
comparison
equal
deleted
inserted
replaced
18460:a2be4f4ac8ed | 18461:35976f73432d |
---|---|
267 map choice (next-digit ?0) | 267 map choice (next-digit ?0) |
268 value) | 268 value) |
269 ;; Define SPC as a prefix char to get to this menu. | 269 ;; Define SPC as a prefix char to get to this menu. |
270 (define-key overriding-terminal-local-map " " | 270 (define-key overriding-terminal-local-map " " |
271 (setq map (make-sparse-keymap title))) | 271 (setq map (make-sparse-keymap title))) |
272 (while items | 272 (save-excursion |
273 (setq choice (car items) items (cdr items)) | 273 (set-buffer (get-buffer-create " widget-choose")) |
274 (if (consp choice) | 274 (erase-buffer) |
275 (let* ((name (car choice)) | 275 (insert "Available choices:\n\n") |
276 (function (cdr choice)) | 276 (while items |
277 (character (aref name 0))) | 277 (setq choice (car items) items (cdr items)) |
278 ;; Pick a character for this choice; | 278 (if (consp choice) |
279 ;; avoid duplication. | 279 (let* ((name (car choice)) |
280 (when (lookup-key map (vector character)) | 280 (function (cdr choice))) |
281 (setq character (downcase character)) | 281 (insert (format "%c = %s\n" next-digit name)) |
282 (when (lookup-key map (vector character)) | 282 (define-key map (vector next-digit) function))) |
283 (setq character next-digit | 283 ;; Allocate digits to disabled alternatives |
284 next-digit (1+ next-digit)))) | 284 ;; so that the digit of a given alternative never varies. |
285 (define-key map (vector character) | 285 (setq next-digit (1+ next-digit))) |
286 (cons (format "%c = %s" character name) function))))) | 286 (insert "\nC-g = Quit")) |
287 (define-key map [?\C-g] '("Quit" . keyboard-quit)) | 287 (define-key map [?\C-g] 'keyboard-quit) |
288 (define-key map [t] 'keyboard-quit) | 288 (define-key map [t] 'keyboard-quit) |
289 (setcdr map (nreverse (cdr map))) | 289 (setcdr map (nreverse (cdr map))) |
290 ;; Unread a SPC to lead to our new menu. | 290 ;; Unread a SPC to lead to our new menu. |
291 (setq unread-command-events (cons ?\ unread-command-events)) | 291 (setq unread-command-events (cons ?\ unread-command-events)) |
292 ;; Read a char with the menu, and return the result | 292 ;; Read a char with the menu, and return the result |
293 ;; that corresponds to it. | 293 ;; that corresponds to it. |
294 (setq value | 294 (save-window-excursion |
295 (lookup-key overriding-terminal-local-map | 295 (display-buffer (get-buffer " widget-choose")) |
296 (read-key-sequence title) t)) | 296 (let ((cursor-in-echo-area t)) |
297 (setq value | |
298 (lookup-key overriding-terminal-local-map | |
299 (read-key-sequence title) t)))) | |
297 (when (eq value 'keyboard-quit) | 300 (when (eq value 'keyboard-quit) |
298 (error "Canceled")) | 301 (error "Canceled")) |
299 value)))) | 302 value)))) |
300 | 303 |
301 (defun widget-remove-if (predictate list) | 304 (defun widget-remove-if (predictate list) |
1991 (widget-value-set widget | 1994 (widget-value-set widget |
1992 (widget-apply current :value-to-external | 1995 (widget-apply current :value-to-external |
1993 (widget-get current :value))) | 1996 (widget-get current :value))) |
1994 (widget-setup) | 1997 (widget-setup) |
1995 (widget-apply widget :notify widget event))) | 1998 (widget-apply widget :notify widget event))) |
1996 (run-hooks 'widget-edit-hook)) | 1999 (run-hook-with-args 'widget-edit-functions widget)) |
1997 | 2000 |
1998 (defun widget-choice-validate (widget) | 2001 (defun widget-choice-validate (widget) |
1999 ;; Valid if we have made a valid choice. | 2002 ;; Valid if we have made a valid choice. |
2000 (let ((void (widget-get widget :void)) | 2003 (let ((void (widget-get widget :void)) |
2001 (choice (widget-get widget :choice)) | 2004 (choice (widget-get widget :choice)) |
2047 | 2050 |
2048 (defun widget-toggle-action (widget &optional event) | 2051 (defun widget-toggle-action (widget &optional event) |
2049 ;; Toggle value. | 2052 ;; Toggle value. |
2050 (widget-value-set widget (not (widget-value widget))) | 2053 (widget-value-set widget (not (widget-value widget))) |
2051 (widget-apply widget :notify widget event) | 2054 (widget-apply widget :notify widget event) |
2052 (run-hooks 'widget-edit-hook)) | 2055 (run-hook-with-args 'widget-edit-functions widget)) |
2053 | 2056 |
2054 ;;; The `checkbox' Widget. | 2057 ;;; The `checkbox' Widget. |
2055 | 2058 |
2056 (define-widget 'checkbox 'toggle | 2059 (define-widget 'checkbox 'toggle |
2057 "A checkbox toggle." | 2060 "A checkbox toggle." |