1 ;;; menudiag.el --- Minibuffer Menu System
3 ;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical
5 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
7 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
8 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
10 ;; This file will be part of GNU Emacs (in future).
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
28 ;; Inspired by the menu subsystem of EGG V3.0
30 ;; Completely different implementation, using keymap and recursive edit.
35 ;; Data structure of MENU
37 ;; <menu> ::= ( menu <prompt> <item-list> )
38 ;; <prompt> ::= STRING
39 ;; <item-list> ::= ( <item> ... )
40 ;; <item> ::= <string> | ( <string> . <value> )
42 ;; <value> ::= <menu> | INTEGER | STRING (Must *NOT* cons cell)
47 ;; <selection-list> ::= ( <line>... )
48 ;; <line> ::= ( <item>... )
51 (defvar menudiag-mode-map
52 (let ((map (make-keymap))
55 (define-key map (char-to-string ch) 'undefined)
59 (define-key map (char-to-string ch) 'undefined)
63 (define-key map (char-to-string ch) 'menudiag-goto-item)
67 (define-key map (char-to-string ch) 'menudiag-goto-item)
71 (define-key map (char-to-string ch) 'menudiag-goto-item)
73 (define-key map "\C-a" 'menudiag-beginning-of-line)
74 (define-key map "\C-e" 'menudiag-end-of-line)
75 (define-key map "\M-<" 'menudiag-beginning-of-items)
76 (define-key map "\M->" 'menudiag-end-of-items)
77 (define-key map "\C-f" 'menudiag-forward-item)
78 (define-key map "\C-b" 'menudiag-backward-item)
79 (define-key map "\C-n" 'menudiag-next-line)
80 (define-key map "\C-p" 'menudiag-previous-line)
81 (define-key map "\C-]" 'menudiag-exit)
82 (define-key map "\C-g" 'menudiag-exit-one-level)
83 (define-key map "\C-l" 'menudiag-redraw)
84 (define-key map "\C-m" 'menudiag-select-this-item)
85 (define-key map [return] 'menudiag-select-this-item)
86 (define-key map [left] 'menudiag-backward-item)
87 (define-key map [right] 'menudiag-forward-item)
88 (define-key map [up] 'menudiag-previous-line)
89 (define-key map [down] 'menudiag-next-line)
90 (define-key map [menudiag-continuation] 'menudiag-follow-continuation)
94 (defun menudiag-menu-p (item)
95 (and (consp item) (eq 'menu (car item))))
97 (defun menudiag-item-string (item)
100 (format "%s" (car item))))
102 (defun menudiag-item-value (item)
107 (defsubst menudiag-item-width (item)
108 (+ 4 (string-width (menudiag-item-string item))))
110 (defun menudiag-make-selection-list (item-list line-width)
115 (let* ((item (car item-list))
116 (item-width (menudiag-item-width item)))
117 (if (and line (>= (+ width item-width) line-width))
118 (setq l (cons (reverse line) l)
121 (setq line (cons item line)
122 width (+ width (menudiag-item-width item))
123 item-list (cdr item-list))))
125 (reverse (cons (reverse line) l))
129 (defun menudiag-select (menu &optional menudiag-continuation return-contin)
131 (if menudiag-continuation
132 (setq unread-command-events (cons 'menudiag-continuation
133 unread-command-events)))
134 (if (not return-contin)
136 (if (catch 'menudiag-exit
137 (menudiag-select-internal menu))
142 (defun menudiag-get-value (continuation)
143 (menudiag-item-value (nth (1- (length continuation)) continuation)))
145 (defun menudiag-follow-continuation ()
147 (let ((item (car menudiag-continuation)))
148 (setq menudiag-continuation (cdr menudiag-continuation))
149 (if menudiag-continuation
150 (setq unread-command-events (cons 'menudiag-continuation
151 unread-command-events)))
154 (if (eq item (nth pos-in-line line))
156 (menudiag-forward-item))))
157 (let ((v (menudiag-item-value item)))
158 (if (menudiag-menu-p v)
161 (menudiag-select-internal v)
164 (setq value (cons item value))))))))
166 (defun menudiag-select-internal (menu)
167 (let* ((minibuf-prompt (nth 1 menu))
169 (menudiag-make-selection-list (nth 2 menu)
170 (- (window-width (minibuffer-window))
171 (string-width minibuf-prompt))))
172 (line (car selection-list))
174 (menudiag-make-menu-formatted-string line)))
177 (read-from-minibuffer minibuf-prompt
178 (cons minibuf-contents 3)
179 menudiag-mode-map))))
181 (defun menudiag-make-menu-formatted-string (item-list)
184 (function (lambda (item)
186 (format " %c.%s" (menudiag-item-num-to-char i)
187 (menudiag-item-string item))))
191 ;; ITEM No --> Character
192 (defun menudiag-item-num-to-char (num)
195 (setq char (+ ?0 num)))
197 (setq char (+ ?a (- num 10))))
201 ;; Character --> ITEM No
202 (defun menudiag-char-to-item-num (char)
204 (cond ((and (<= ?0 ch) (<= ch ?9))
205 (setq num (- ch ?0)))
206 ((and (<= ?a ch) (<= ch ?z))
207 (setq num (+ 10 (- ch ?a))))
208 ((and (<= ?A ch) (<= ch ?Z))
209 (setq num (+ 10 (- ch ?A))))
214 (defun menudiag-goto-item ()
216 (let ((ch last-command-char)
218 (setq n (menudiag-char-to-item-num ch))
219 (if (>= n (length line))
220 (error "No such item")
221 (menudiag-goto-item-internal n))))
223 (defun menudiag-goto-item-internal (n)
224 (let ((old-pos-in-line pos-in-line)
228 (while (< i pos-in-line)
229 (setq p (+ p (length (menudiag-item-string (nth i line))) 4))
233 (defun menudiag-beginning-of-items ()
235 (menudiag-goto-line 0)
236 (menudiag-beginning-of-line))
238 (defun menudiag-end-of-items ()
240 (menudiag-goto-line (1- (length selection-list)))
241 (menudiag-end-of-line))
243 (defun menudiag-beginning-of-line ()
245 (menudiag-goto-item-internal 0))
247 (defun menudiag-end-of-line ()
249 (menudiag-goto-item-internal (1- (length line))))
251 (defun menudiag-forward-item ()
253 (if (< pos-in-line (1- (length line)))
254 (menudiag-goto-item-internal (1+ pos-in-line))
255 (if (>= linepos (1- (length selection-list)))
256 (signal 'end-of-buffer "")
257 (menudiag-goto-line (1+ linepos))
258 (menudiag-beginning-of-line))))
260 (defun menudiag-backward-item ()
262 (if (< 0 pos-in-line)
263 (menudiag-goto-item-internal (1- pos-in-line))
265 (signal 'beginning-of-buffer "")
266 (menudiag-goto-line (1- linepos))
267 (menudiag-end-of-line))))
269 (defun menudiag-goto-line (n)
270 (if (or (>= n (length selection-list)) (< n 0))
272 (setq line (nth n selection-list)
274 (delete-region (point-min) (point-max))
275 (insert (menudiag-make-menu-formatted-string line))))
277 (defun menudiag-next-line ()
279 (menudiag-goto-line (1+ linepos))
280 (if (< pos-in-line (length line))
281 (menudiag-goto-item-internal pos-in-line)
282 (menudiag-end-of-line)))
284 (defun menudiag-previous-line ()
286 (menudiag-goto-line (1- linepos))
287 (if (< pos-in-line (length line))
288 (menudiag-goto-item-internal pos-in-line)
289 (menudiag-end-of-line)))
291 (defun menudiag-redraw ()
293 (menudiag-goto-line linepos)
294 (menudiag-goto-item-internal pos-in-line))
296 (defun menudiag-exit-one-level ()
300 (defun menudiag-exit ()
302 (throw 'menudiag-exit t))
304 (defun menudiag-select-this-item ()
306 (let* ((item (nth pos-in-line line))
307 (v (menudiag-item-value item)))
308 (if (menudiag-menu-p v)
311 (menudiag-select-internal v)
314 (setq value (cons item value))))
316 (setq value (menudiag-item-value item))
317 (setq value (cons item nil)))
318 (throw 'menudiag-exit nil))))
321 ;;; menudiag.el ends here.