1 ;;; menudiag.el --- Minibuffer Menu System
3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
5 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
7 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
9 ;; Keywords: mule, multilingual, input method
11 ;; This file is part of EGG.
13 ;; EGG 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)
18 ;; EGG 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.
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 the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
29 ;; Inspired by the menu subsystem of EGG V3.0
31 ;; Completely different implementation, using keymap and recursive edit.
36 ;; Data structure of MENU
38 ;; <menu> ::= ( menu <prompt> <item-list> )
39 ;; <prompt> ::= STRING
40 ;; <item-list> ::= ( <item> ... )
41 ;; <item> ::= <string> | ( <string> . <value> )
43 ;; <value> ::= <menu> | INTEGER | STRING (Must *NOT* cons cell)
48 ;; <selection-list> ::= ( <line>... )
49 ;; <line> ::= ( <item>... )
52 (defgroup menudiag nil
53 "Input Translation System of Tamago 4."
56 (defcustom menudiag-select-without-return nil
57 "*Number keys not only goes the item, but also select the item, if non-NIL."
58 :group 'menudiag :type 'boolean)
60 (defvar menudiag-mode-map
61 (let ((map (make-sparse-keymap))
65 (define-key map (char-to-string ch) 'menudiag-goto-item)
69 (define-key map (char-to-string ch) 'menudiag-goto-item)
73 (define-key map (char-to-string ch) 'menudiag-goto-item)
77 (define-key map (vector ch) 'digit-argument)
79 (define-key map [?\C--] 'negative-argument)
80 (define-key map [?\C-u] 'universal-argument)
81 (define-key map " " 'menudiag-forward-item)
82 (define-key map "\C-a" 'menudiag-beginning-of-line)
83 (define-key map "\C-e" 'menudiag-end-of-line)
84 (define-key map "\M-<" 'menudiag-beginning-of-items)
85 (define-key map "\M->" 'menudiag-end-of-items)
86 (define-key map "\C-f" 'menudiag-forward-item)
87 (define-key map "\C-b" 'menudiag-backward-item)
88 (define-key map "\C-n" 'menudiag-next-line)
89 (define-key map "\C-p" 'menudiag-previous-line)
90 (define-key map "\C-]" 'menudiag-exit)
91 (define-key map "\C-g" 'menudiag-exit-one-level)
92 (define-key map "\C-l" 'menudiag-redraw)
93 (define-key map "\C-m" 'menudiag-select-this-item)
94 (define-key map "\M-v" 'menudiag-list-other-window)
95 (define-key map "?" 'menudiag-list-other-window)
96 (define-key map [return] 'menudiag-select-this-item)
97 (define-key map [left] 'menudiag-backward-item)
98 (define-key map [right] 'menudiag-forward-item)
99 (define-key map [up] 'menudiag-previous-line)
100 (define-key map [down] 'menudiag-next-line)
101 (define-key map [exit] 'menudiag-exit)
102 (define-key map [t] 'undefined)
106 (defun menudiag-menu-p (item)
107 (and (consp item) (eq 'menu (car item))))
109 (defun menudiag-item-string (item)
112 (format "%s" (car item))))
114 (defun menudiag-item-value (item)
119 (defsubst menudiag-item-width (item)
120 (+ 4 (string-width (menudiag-item-string item))))
122 (defun menudiag-make-selection-list (item-list line-width)
128 (let* ((item (car item-list))
129 (item-width (menudiag-item-width item)))
130 (if (and line (or (>= (+ width item-width) line-width)
132 (setq l (cons (reverse line) l)
136 (setq line (cons item line)
137 width (+ width (menudiag-item-width item))
139 item-list (cdr item-list))))
141 (reverse (cons (reverse line) l))
144 (defvar menudiag-show-all nil)
145 (make-variable-buffer-local 'menudiag-show-all)
147 (defvar menudiag-continuation nil)
148 (make-variable-buffer-local 'menudiag-continuation)
150 (defvar menudiag-return-contin nil)
151 (make-variable-buffer-local 'menudiag-return-contin)
153 (defvar menudiag-value nil)
154 (make-variable-buffer-local 'menudiag-value)
156 (defvar menudiag-done nil)
157 (make-variable-buffer-local 'menudiag-done)
160 (defun menudiag-select (menu &optional list-all continuation return-contin)
161 (let ((enable-recursive-minibuffers t))
162 (setq menudiag-return-contin return-contin)
163 (menudiag-select-internal menu list-all continuation)
164 (if (eq menudiag-done t)
168 (defvar menudiag-line nil)
169 (make-variable-buffer-local 'menudiag-line)
171 (defvar menudiag-linepos 0)
172 (make-variable-buffer-local 'menudiag-linepos)
174 (defvar menudiag-pos-in-line 0)
175 (make-variable-buffer-local 'menudiag-pos-in-line)
177 (defun menudiag-follow-continuation ()
178 (let* ((item (car menudiag-continuation))
179 (value (menudiag-item-value item))
180 (pos (menudiag-search-item item)))
182 (error "no such item: %s" (menudiag-item-string item)))
183 (menudiag-goto-line (car pos))
184 (menudiag-goto-item-internal (cdr pos))
185 (when (menudiag-menu-p value)
186 (menudiag-select-internal value
188 (cdr menudiag-continuation))
191 (when menudiag-return-contin
192 (setq menudiag-value (cons item menudiag-value)))
193 (setq unread-command-events (cons 'exit unread-command-events))))))
195 (defvar menudiag-minibuffer-list nil)
196 (defvar menudiag-variable-alist nil)
198 (defmacro menudiag-send-variables (&rest args)
199 `(setq menudiag-variable-alist
200 (list ,@(mapcar (lambda (var) `(cons ',var ,var)) args))))
202 (defmacro menudiag-send-variables-with-value (&rest args)
203 `(setq menudiag-variable-alist
204 ,(let ((alist (list 'list)))
206 (nconc alist `((cons ',(car args) ,(cadr args))))
207 (setq args (cddr args)))
210 (defun menudiag-receive-variables ()
211 (while menudiag-variable-alist
212 (set (caar menudiag-variable-alist) (cdar menudiag-variable-alist))
213 (setq menudiag-variable-alist (cdr menudiag-variable-alist))))
215 (defvar menudiag-minibuf-prompt nil)
216 (make-variable-buffer-local 'menudiag-minibuf-prompt)
218 (defvar menudiag-current-items nil)
219 (make-variable-buffer-local 'menudiag-current-items)
221 (defvar menudiag-selection-list nil)
222 (make-variable-buffer-local 'menudiag-selection-list)
224 (defun menudiag-minibuffer-hook ()
226 (remove-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook)
227 (setq menudiag-minibuffer-list (cons (current-buffer)
228 menudiag-minibuffer-list))
229 (buffer-disable-undo)
230 (menudiag-receive-variables)
231 (menudiag-beginning-of-items)
232 (when menudiag-continuation
233 (menudiag-follow-continuation))
234 (when (and menudiag-show-all (null menudiag-done))
235 (menudiag-list-other-window)))
237 (defun menudiag-select-internal (menu all &optional continuation)
238 (menudiag-send-variables-with-value
239 menudiag-value menudiag-value
240 menudiag-continuation continuation
241 menudiag-return-contin menudiag-return-contin
242 menudiag-show-all all
243 menudiag-minibuf-prompt (cadr menu)
244 menudiag-current-items (car (cddr menu))
245 menudiag-selection-list (menudiag-make-selection-list
247 (- (window-width (minibuffer-window))
248 (string-width (cadr menu)))))
249 (add-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook)
252 (read-from-minibuffer "" "" menudiag-mode-map)
253 (menudiag-receive-variables))
254 (setq menudiag-minibuffer-list (cdr menudiag-minibuffer-list))
255 (remove-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook)
256 ;; for egg's point-enterd/left hooks
258 (goto-char (point-min)))))
260 (defun menudiag-make-menu-formatted-string (item-list)
263 (function (lambda (item)
265 (format " %c.%s" (menudiag-item-num-to-char i)
266 (menudiag-item-string item))))
270 ;; ITEM No --> Character
271 (defun menudiag-item-num-to-char (num)
274 (setq char (+ ?0 num)))
276 (setq char (+ ?a (- num 10))))
280 ;; Character --> ITEM No
281 (defun menudiag-char-to-item-num (ch)
283 (cond ((and (<= ?0 ch) (<= ch ?9))
284 (setq num (- ch ?0)))
285 ((and (<= ?a ch) (<= ch ?z))
286 (setq num (+ 10 (- ch ?a))))
287 ((and (<= ?A ch) (<= ch ?Z))
288 (setq num (+ 10 (- ch ?A))))
292 (defun menudiag-check-current-menu ()
293 (or (eq (current-buffer) (car menudiag-minibuffer-list))
294 (error "menudiag: not current menu")))
296 (defun menudiag-goto-item ()
298 (menudiag-check-current-menu)
299 (let ((ch last-command-char)
301 (setq n (menudiag-char-to-item-num ch))
302 (if (>= n (length menudiag-line))
303 (error "No such item")
304 (menudiag-goto-item-internal n)
305 (if menudiag-select-without-return
306 (menudiag-select-this-item)))))
308 (defun menudiag-goto-item-internal (n)
309 (let ((p (+ (length menudiag-minibuf-prompt) 3))
311 (setq menudiag-pos-in-line n)
312 (while (< i menudiag-pos-in-line)
313 (setq p (+ p (length (menudiag-item-string (nth i menudiag-line))) 4))
317 (defun menudiag-beginning-of-items ()
319 (menudiag-check-current-menu)
320 (menudiag-goto-line 0)
321 (menudiag-beginning-of-line))
323 (defun menudiag-end-of-items ()
325 (menudiag-check-current-menu)
326 (menudiag-goto-line (1- (length menudiag-selection-list)))
327 (menudiag-end-of-line))
329 (defun menudiag-beginning-of-line ()
331 (menudiag-check-current-menu)
332 (menudiag-goto-item-internal 0))
334 (defun menudiag-end-of-line ()
336 (menudiag-check-current-menu)
337 (menudiag-goto-item-internal (1- (length menudiag-line))))
339 ;; Should retain compatibility. Must.
341 ;;(defun menudiag-forward-item ()
343 ;; (if (< pos-in-line (1- (length line)))
344 ;; (menudiag-goto-item-internal (1+ pos-in-line))
345 ;; (if (>= linepos (1- (length selection-list)))
346 ;; (signal 'end-of-buffer "")
347 ;; (menudiag-goto-line (1+ linepos))
348 ;; (menudiag-beginning-of-line))))
350 ;;(defun menudiag-backward-item ()
352 ;; (if (< 0 pos-in-line)
353 ;; (menudiag-goto-item-internal (1- pos-in-line))
355 ;; (signal 'beginning-of-buffer "")
356 ;; (menudiag-goto-line (1- linepos))
357 ;; (menudiag-end-of-line))))
359 ;;(defun menudiag-goto-line (n)
360 ;; (if (or (>= n (length selection-list)) (< n 0))
362 ;; (setq line (nth n selection-list)
364 ;; (delete-region (point-min) (point-max))
365 ;; (insert (menudiag-make-menu-formatted-string line))))
368 (defun menudiag-forward-item (n)
370 (menudiag-forward-item-internal n))
372 (defun menudiag-backward-item (n)
374 (menudiag-forward-item-internal (- n)))
376 (defun menudiag-forward-item-internal (n)
377 (menudiag-check-current-menu)
378 (setq n (+ n menudiag-pos-in-line))
380 (menudiag-goto-line (1- menudiag-linepos))
381 (setq n (+ n (length menudiag-line))))
382 (while (>= n (length menudiag-line))
383 (setq n (- n (length menudiag-line)))
384 (menudiag-goto-line (1+ menudiag-linepos)))
385 (menudiag-goto-item-internal n))
387 (defun menudiag-goto-line (n)
388 (let ((len (length menudiag-selection-list)))
390 (setq n (+ (% n len) len)))
393 (setq menudiag-line (nth n menudiag-selection-list)
395 (let ((inhibit-read-only t))
397 (insert menudiag-minibuf-prompt
398 (menudiag-make-menu-formatted-string menudiag-line))
399 (set-text-properties (point-min) (point-max) '(read-only t)))))
401 (defun menudiag-next-line (n)
403 (menudiag-next-line-internal n))
405 (defun menudiag-previous-line (n)
407 (menudiag-next-line-internal (- n)))
409 (defun menudiag-next-line-internal (n)
410 (menudiag-check-current-menu)
411 (menudiag-goto-line (+ menudiag-linepos n))
412 (if (< menudiag-pos-in-line (length menudiag-line))
413 (menudiag-goto-item-internal menudiag-pos-in-line)
414 (menudiag-end-of-line)))
416 (defun menudiag-redraw ()
418 (menudiag-check-current-menu)
419 (menudiag-goto-line menudiag-linepos)
420 (menudiag-goto-item-internal menudiag-pos-in-line))
422 (defun menudiag-exit-one-level ()
424 (menudiag-check-current-menu)
425 (menudiag-exit-minibuffer))
427 (defun menudiag-exit ()
429 (menudiag-check-current-menu)
430 (unless menudiag-done
431 (setq menudiag-done 'quit))
432 (menudiag-exit-minibuffer))
434 (defun menudiag-select-this-item (&optional all)
436 (menudiag-check-current-menu)
437 (let* ((item (nth menudiag-pos-in-line menudiag-line))
438 (v (menudiag-item-value item)))
439 (if (menudiag-menu-p v)
441 (menudiag-restore-window)
442 (menudiag-select-internal v all)
445 (when menudiag-return-contin
446 (setq menudiag-value (cons item menudiag-value)))
447 (menudiag-exit-minibuffer))
449 (menudiag-list-other-window))))
450 (setq menudiag-value (if menudiag-return-contin
452 (menudiag-item-value item))
454 (menudiag-exit-minibuffer))))
456 (defun menudiag-search-item (item)
457 (let ((selection-list menudiag-selection-list)
460 (while (and selection-list
461 (null (setq rest (memq item (car selection-list)))))
462 (setq selection-list (cdr selection-list)
465 (cons line (- (length (car selection-list)) (length rest))))))
467 (defconst menudiag-selection-map
468 (let ((map (make-sparse-keymap))
471 (define-key map (char-to-string ch) 'menudiag-selection-goto)
473 (define-key map "q" 'menudiag-retun-to-minibuf)
474 (define-key map "\C-b" 'previous-completion)
475 (define-key map "\M-b" 'previous-completion)
476 (define-key map "\C-f" 'next-completion)
477 (define-key map "\M-f" 'next-completion)
478 (define-key map " " 'next-completion)
479 (define-key map "\C-g" 'menudiag-selection-exit-one-level)
480 (define-key map "\C-m" 'menudiag-choose-item)
481 (define-key map "\C-]" 'menudiag-selection-exit)
482 (define-key map "\177" 'menudiag-selection-goto-delete)
483 (define-key map [delete] 'menudiag-selection-goto-delete)
484 (define-key map [backspace] 'menudiag-selection-goto-delete)
485 (define-key map [right] 'next-completion)
486 (define-key map [left] 'previous-completion)
487 (define-key map [return] 'menudiag-choose-item)
488 (define-key map [mouse-2] 'menudiag-mouse-choose-item)
490 "keymap for menu selection mode")
492 (defvar menudiag-window-conf nil)
493 (make-variable-buffer-local 'menudiag-window-conf)
495 (defvar menudiag-selection-buffer nil)
496 (make-variable-buffer-local 'menudiag-selection-buffer)
498 (defvar menudiag-selection-main-buffer nil)
499 (make-variable-buffer-local 'menudiag-selection-main-buffer)
501 (defun menudiag-selection-mode ()
502 (kill-all-local-variables)
503 (make-local-variable 'inhibit-read-only)
504 (setq buffer-read-only t
505 inhibit-read-only nil)
506 (make-local-hook 'post-command-hook)
507 (add-hook 'post-command-hook 'menudiag-selection-align-to-item nil t)
508 (use-local-map menudiag-selection-map)
509 (setq mode-name "Menudiag Selection")
510 (setq major-mode 'menudiag-selection-mode))
512 (defun menudiag-max-item-width (items)
513 (apply 'max (mapcar 'menudiag-item-width items)))
515 (defun menudiag-buffer-show-function ()
516 (menudiag-receive-variables)
517 (let* ((items menudiag-current-items)
518 (digits (length (number-to-string (length items))))
519 (form (concat "%" (number-to-string digits) "d. %s"))
520 (columns (max 1 (/ (window-width (selected-window))
521 (+ digits (menudiag-max-item-width items)))))
522 (width (/ (window-width (selected-window)) columns))
527 str (format form n (menudiag-item-string (car items))))
529 (set-text-properties p (point) '(mouse-face highlight))
535 (insert (make-string (- width (string-width str)) ?\ ))
538 (goto-char (point-min))
539 (set-buffer-modified-p nil)
540 (menudiag-selection-mode)))
542 (defun menudiag-buffer-name (prompt)
543 (let ((len (1- (length prompt))))
544 (generate-new-buffer-name
545 (if (= (aref prompt len) ?:) (substring prompt 0 len) prompt))))
547 (defun menudiag-list-other-window ()
549 (menudiag-check-current-menu)
550 (let ((window (and menudiag-selection-buffer
551 (get-buffer-window menudiag-selection-buffer))))
553 (select-window window)
554 (let ((temp-buffer-show-hook 'menudiag-buffer-show-function)
555 (main-buf (current-buffer))
556 (selection-list menudiag-selection-list)
557 (linepos menudiag-linepos)
558 (n (1+ menudiag-pos-in-line)))
559 (setq menudiag-window-conf (current-window-configuration))
560 (menudiag-send-variables menudiag-current-items)
561 (with-output-to-temp-buffer
562 (menudiag-buffer-name menudiag-minibuf-prompt)
563 (setq menudiag-selection-buffer standard-output))
564 (switch-to-buffer-other-window menudiag-selection-buffer)
565 (setq menudiag-selection-main-buffer main-buf
566 menudiag-selection-list selection-list)
568 (setq linepos (1- linepos)
569 n (+ n (length (car selection-list)))
570 selection-list (cdr selection-list)))
571 (next-completion n)))))
573 (defun menudiag-check-current-menu-list ()
574 (or (eq menudiag-selection-main-buffer (car menudiag-minibuffer-list))
575 (error "menudiag: not current menu list")))
577 (defun menudiag-choose-item ()
579 (menudiag-choose-item-internal nil))
581 (defun menudiag-mouse-choose-item (event)
583 (set-buffer (window-buffer (caadr event)))
584 (menudiag-choose-item-internal event))
586 (defun menudiag-choose-item-internal (event)
587 (menudiag-check-current-menu-list)
588 (let ((org-buf menudiag-selection-main-buffer)
589 (sel-buf (current-buffer))
590 (item-list menudiag-selection-list)
594 (setq tmp-buf (current-buffer))
596 (setq completion-reference-buffer tmp-buf)
598 (mouse-choose-completion event)
601 (setq n (string-to-int (buffer-string))))
602 (pop-to-buffer org-buf)
603 (while (and item-list (>= n (length (car item-list))))
605 n (- n (length (car item-list)))
606 item-list (cdr item-list)))
607 (menudiag-goto-line l)
608 (menudiag-goto-item-internal n)
609 (menudiag-select-this-item t)))
611 (defvar menudiag-goto-number-list nil)
612 (make-variable-buffer-local 'menudiag-goto-number-list)
614 (defvar menudiag-original-point nil)
615 (make-variable-buffer-local' menudiag-original-point)
617 (defun menudiag-selection-goto ()
619 (unless (eq last-command 'menudiag-selection-goto)
620 (setq menudiag-goto-number-list nil
621 menudiag-original-point (point)))
622 (setq menudiag-goto-number-list (cons (- last-command-char ?0)
623 menudiag-goto-number-list))
624 (menudiag-selection-goto-internal))
626 (defun menudiag-selection-goto-internal ()
627 (let* ((list menudiag-goto-number-list)
628 (n (menudiag-selection-item-number list))
630 (set-buffer menudiag-selection-main-buffer)
631 (length menudiag-current-items))))
632 (setq this-command 'menudiag-selection-goto)
636 (setq menudiag-goto-number-list (cdr list)))
637 (goto-char (point-min))
638 (next-completion (1+ n)))))
640 (defun menudiag-selection-item-number (list)
644 (setq n (+ (* (car list) exp) n)
649 (defun menudiag-selection-goto-delete (n)
651 (if (null (eq last-command 'menudiag-selection-goto))
653 (setq menudiag-goto-number-list (nthcdr n menudiag-goto-number-list))
654 (if (null menudiag-goto-number-list)
655 (goto-char menudiag-original-point)
656 (menudiag-selection-goto-internal))))
658 (defun menudiag-selection-align-to-item ()
661 ((get-text-property (1- (point)) 'mouse-face)
662 (goto-char (previous-single-property-change (point) 'mouse-face)))))
664 (defun menudiag-restore-window ()
665 (when menudiag-window-conf
666 (set-window-configuration menudiag-window-conf)
667 (kill-buffer menudiag-selection-buffer)))
669 (defun menudiag-exit-minibuffer ()
670 (menudiag-restore-window)
671 (menudiag-send-variables menudiag-done menudiag-value)
675 (defun menudiag-retun-to-minibuf ()
677 (menudiag-check-current-menu-list)
678 (unless (minibuffer-window-active-p (minibuffer-window))
679 (set-minibuffer-window (minibuffer-window)))
680 (let ((window (get-buffer-window menudiag-selection-main-buffer)))
682 (select-window window)
683 (error "menudiag: cannot find minibuffer"))))
685 (defun menudiag-selection-exit-one-level ()
687 (set-buffer menudiag-selection-main-buffer)
688 (menudiag-exit-one-level))
690 (defun menudiag-selection-exit ()
692 (set-buffer menudiag-selection-main-buffer)
696 ;;; menudiag.el ends here.