menudiag.el

   1 ;;; menudiag.el --- Minibuffer Menu System
   2
   3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
   4
   5 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
   6
   7 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
   8
   9 ;; Keywords: mule, multilingual, input method
  10
  11 ;; This file is part of EGG.
  12
  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)
  16 ;; any later version.
  17
  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.
  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 the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29 ;; Inspired by the menu subsystem of EGG V3.0
  30 ;;
  31 ;; Completely different implementation, using keymap and recursive edit.
  32
  33 ;;; Code:
  34
  35 ;;
  36 ;; Data structure of MENU
  37 ;;
  38 ;; <menu> ::= ( menu <prompt> <item-list> )
  39 ;; <prompt> ::= STRING
  40 ;; <item-list> ::= ( <item> ... )
  41 ;; <item> ::= <string> | ( <string> . <value> )
  42 ;;
  43 ;; <value> ::=  <menu> | INTEGER | STRING  (Must *NOT* cons cell)
  44 ;;
  45 ;;
  46 ;
  47 ;;
  48 ;; <selection-list> ::= ( <line>... )
  49 ;; <line>  ::= ( <item>... )
  50 ;;
  51
  52 (defgroup menudiag nil
  53   "Input Translation System of Tamagotchy"
  54   :group 'egg)
  55
  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)
  59
  60 (defvar menudiag-mode-map
  61   (let ((map (make-sparse-keymap))
  62         ch)
  63     (setq ch ?0)
  64     (while (<= ch ?9)
  65       (define-key map (char-to-string ch) 'menudiag-goto-item)
  66       (setq ch (1+ ch)))
  67     (setq ch ?a)
  68     (while (<= ch ?z)
  69       (define-key map (char-to-string ch) 'menudiag-goto-item)
  70       (setq ch (1+ ch)))
  71     (setq ch ?A)
  72     (while (<= ch ?Z)
  73       (define-key map (char-to-string ch) 'menudiag-goto-item)
  74       (setq ch (1+ ch)))
  75     (define-key map "\C-a" 'menudiag-beginning-of-line)
  76     (define-key map "\C-e" 'menudiag-end-of-line)
  77     (define-key map "\M-<" 'menudiag-beginning-of-items)
  78     (define-key map "\M->" 'menudiag-end-of-items)
  79     (define-key map "\C-f" 'menudiag-forward-item)
  80     (define-key map "\C-b" 'menudiag-backward-item)
  81     (define-key map "\C-n" 'menudiag-next-line)
  82     (define-key map "\C-p" 'menudiag-previous-line)
  83     (define-key map "\C-]" 'menudiag-exit)
  84     (define-key map "\C-g" 'menudiag-exit-one-level)
  85     (define-key map "\C-l" 'menudiag-redraw)
  86     (define-key map "\C-m" 'menudiag-select-this-item)
  87     (define-key map "?"    'menudiag-list-other-window)
  88     (define-key map [return] 'menudiag-select-this-item)
  89     (define-key map [left] 'menudiag-backward-item)
  90     (define-key map [right] 'menudiag-forward-item)
  91     (define-key map [up] 'menudiag-previous-line)
  92     (define-key map [down] 'menudiag-next-line)
  93     (define-key map [menudiag-continuation] 'menudiag-follow-continuation)
  94     (define-key map [t] 'undefined)
  95     map)
  96   "Keymap for MENU.")
  97
  98 (defun menudiag-menu-p (item)
  99   (and (consp item) (eq 'menu (car item))))
 100
 101 (defun menudiag-item-string (item)
 102   (if (stringp item)
 103       item
 104     (format "%s" (car item))))
 105
 106 (defun menudiag-item-value (item)
 107   (if (stringp item)
 108       item
 109     (cdr item)))
 110
 111 (defsubst menudiag-item-width (item)
 112   (+ 4 (string-width (menudiag-item-string item))))
 113
 114 (defvar menudiag-window-conf nil)
 115
 116 (defun menudiag-make-selection-list (item-list line-width)
 117   (let ((l nil)
 118         (line nil)
 119         (width 0)
 120         (i 0))
 121     (while item-list
 122       (let* ((item (car item-list))
 123              (item-width (menudiag-item-width item)))
 124         (if (and line (or (>= (+ width item-width) line-width)
 125                           (>= i 36)))
 126             (setq l (cons (reverse line) l)
 127                   line nil
 128                   width 0
 129                   i 0))
 130         (setq line (cons item line)
 131               width (+ width (menudiag-item-width item))
 132               i (1+ i)
 133               item-list (cdr item-list))))
 134     (if line
 135         (reverse (cons (reverse line) l))
 136       (reverse l))))
 137
 138 ;; Entry function
 139 (defun menudiag-select (menu &optional menudiag-continuation return-contin)
 140   (let ((enable-recursive-minibuffers t)
 141         value done)
 142     (setq menudiag-window-conf nil)
 143     (if menudiag-continuation
 144         (setq unread-command-events (cons 'menudiag-continuation
 145                                           unread-command-events)))
 146     (if (not return-contin)
 147         (setq value t))
 148     (menudiag-select-internal menu)
 149     (if (eq done t)
 150         value
 151       (signal 'quit ""))))
 152
 153 ;; Entry function
 154 (defun menudiag-get-value (continuation)
 155   (menudiag-item-value (nth (1- (length continuation)) continuation)))
 156
 157 (defun menudiag-follow-continuation ()
 158   (interactive)
 159   (let ((item (car menudiag-continuation)))
 160     (setq menudiag-continuation (cdr menudiag-continuation))
 161     (if menudiag-continuation
 162         (setq unread-command-events (cons 'menudiag-continuation
 163                                           unread-command-events)))
 164     (if (eq item 'menudiag-list-all)
 165         (menudiag-list-other-window)
 166       (let ((in-loop t))
 167         (while in-loop
 168           (if (eq item (nth pos-in-line line))
 169               (setq in-loop nil)
 170             (menudiag-forward-item)
 171             (if (and (= linepos 0) (= pos-in-line 0))
 172                 (error "no such item: %s" (menudiag-item-string item))))))
 173       (let ((v (menudiag-item-value item)))
 174         (if (menudiag-menu-p v)
 175             (unwind-protect
 176                 (progn
 177                   (menudiag-select-internal v)
 178                   (menudiag-redraw))
 179               (if (consp value)
 180                   (setq value (cons item value)))
 181               (if done (menudiag-exit-minibuffer))))))))
 182
 183 (defun menudiag-select-internal (menu)
 184   (let* ((minibuf-prompt (nth 1 menu))
 185          (current-items (nth 2 menu))
 186          (selection-list
 187           (menudiag-make-selection-list current-items
 188                                         (- (window-width (minibuffer-window))
 189                                            (string-width minibuf-prompt))))
 190          (line (car selection-list))
 191          (minibuf-contents
 192           (menudiag-make-menu-formatted-string line)))
 193     (let ((linepos 0)
 194           (pos-in-line 0))
 195       (read-from-minibuffer minibuf-prompt
 196                             (cons minibuf-contents 3)
 197                             menudiag-mode-map))))
 198
 199 (defun menudiag-make-menu-formatted-string (item-list)
 200   (let ((i -1))
 201     (mapconcat
 202      (function (lambda (item)
 203                  (setq i (1+ i))
 204                  (format "  %c.%s" (menudiag-item-num-to-char i)
 205                            (menudiag-item-string item))))
 206      item-list "")))
 207
 208
 209 ;; ITEM No --> Character
 210 (defun menudiag-item-num-to-char (num)
 211   (let ((char))
 212     (cond ((<= num 9)
 213            (setq char (+ ?0 num)))
 214           (t
 215            (setq char (+ ?a (- num 10))))
 216           )
 217     char))
 218
 219 ;; Character --> ITEM No
 220 (defun menudiag-char-to-item-num (char)
 221   (let ((num))
 222     (cond ((and (<= ?0 ch) (<= ch ?9))
 223            (setq num (- ch ?0)))
 224           ((and (<= ?a ch) (<= ch ?z))
 225            (setq num (+ 10 (- ch ?a))))
 226           ((and (<= ?A ch) (<= ch ?Z))
 227            (setq num (+ 10 (- ch ?A))))
 228           (t (setq num 1000)))
 229     num))
 230
 231 (defun menudiag-goto-item ()
 232   (interactive)
 233   (let ((ch last-command-char)
 234         (n 0))
 235     (setq n (menudiag-char-to-item-num ch))
 236     (if (>= n (length line))
 237         (error "No such item")
 238       (menudiag-goto-item-internal n)
 239       (if menudiag-select-without-return
 240           (menudiag-select-this-item)))))
 241
 242 (defun menudiag-goto-item-internal (n)
 243   (let ((old-pos-in-line pos-in-line)
 244         (p 3)
 245         (i 0))
 246     (setq pos-in-line n)
 247     (while (< i pos-in-line)
 248       (setq p (+ p (length (menudiag-item-string (nth i line))) 4))
 249       (setq i (1+ i)))
 250     (goto-char p)))
 251
 252 (defun menudiag-beginning-of-items ()
 253   (interactive)
 254   (menudiag-goto-line 0)
 255   (menudiag-beginning-of-line))
 256
 257 (defun menudiag-end-of-items ()
 258   (interactive)
 259   (menudiag-goto-line (1- (length selection-list)))
 260   (menudiag-end-of-line))
 261
 262 (defun menudiag-beginning-of-line ()
 263   (interactive)
 264   (menudiag-goto-item-internal 0))
 265
 266 (defun menudiag-end-of-line ()
 267   (interactive)
 268   (menudiag-goto-item-internal (1- (length line))))
 269
 270 ;; Should retain compatibility.  Must.
 271 ;;
 272 ;;(defun menudiag-forward-item ()
 273 ;;  (interactive)
 274 ;;  (if (< pos-in-line (1- (length line)))
 275 ;;      (menudiag-goto-item-internal (1+ pos-in-line))
 276 ;;    (if (>= linepos (1- (length selection-list)))
 277 ;;      (signal 'end-of-buffer "")
 278 ;;      (menudiag-goto-line (1+ linepos))
 279 ;;      (menudiag-beginning-of-line))))
 280 ;;
 281 ;;(defun menudiag-backward-item ()
 282 ;;  (interactive)
 283 ;;  (if (< 0 pos-in-line)
 284 ;;      (menudiag-goto-item-internal (1- pos-in-line))
 285 ;;    (if (< linepos 1)
 286 ;;      (signal 'beginning-of-buffer "")
 287 ;;      (menudiag-goto-line (1- linepos))
 288 ;;      (menudiag-end-of-line))))
 289 ;;
 290 ;;(defun menudiag-goto-line (n)
 291 ;;  (if (or (>= n (length selection-list)) (< n 0))
 292 ;;      (ding)
 293 ;;    (setq line (nth n selection-list)
 294 ;;        linepos n)
 295 ;;    (delete-region (point-min) (point-max))
 296 ;;    (insert (menudiag-make-menu-formatted-string line))))
 297 ;;
 298
 299 (defun menudiag-forward-item ()
 300   (interactive)
 301   (if (< pos-in-line (1- (length line)))
 302       (menudiag-goto-item-internal (1+ pos-in-line))
 303     (if (>= linepos (1- (length selection-list)))
 304         (menudiag-goto-line 0)
 305       (menudiag-goto-line (1+ linepos)))
 306     (menudiag-beginning-of-line)))
 307
 308 (defun menudiag-backward-item ()
 309   (interactive)
 310   (if (< 0 pos-in-line)
 311       (menudiag-goto-item-internal (1- pos-in-line))
 312     (if (< linepos 1)
 313         (menudiag-goto-line (1- (length selection-list)))
 314       (menudiag-goto-line (1- linepos)))
 315     (menudiag-end-of-line)))
 316
 317 (defun menudiag-goto-line (n)
 318   (cond
 319    ((>= n (length selection-list))
 320     (setq n 0))
 321    ((< n 0)
 322     (setq n (1- (length selection-list)))))
 323   (setq line (nth n selection-list)
 324         linepos n)
 325   (delete-region (point-min) (point-max))
 326   (insert (menudiag-make-menu-formatted-string line)))
 327
 328 (defun menudiag-next-line ()
 329   (interactive)
 330   (menudiag-goto-line (1+ linepos))
 331   (if (< pos-in-line (length line))
 332       (menudiag-goto-item-internal pos-in-line)
 333     (menudiag-end-of-line)))
 334
 335 (defun menudiag-previous-line ()
 336   (interactive)
 337   (menudiag-goto-line (1- linepos))
 338   (if (< pos-in-line (length line))
 339       (menudiag-goto-item-internal pos-in-line)
 340     (menudiag-end-of-line)))
 341
 342 (defun menudiag-redraw ()
 343   (interactive)
 344   (menudiag-goto-line linepos)
 345   (menudiag-goto-item-internal pos-in-line))
 346
 347 (defun menudiag-exit-one-level ()
 348   (interactive)
 349   (menudiag-exit-minibuffer))
 350
 351 (defun menudiag-exit ()
 352   (interactive)
 353   (setq done 'quit)
 354   (menudiag-exit-minibuffer))
 355
 356 (defun menudiag-select-this-item ()
 357   (interactive)
 358   (let* ((item (nth pos-in-line line))
 359          (v (menudiag-item-value item)))
 360     (if (menudiag-menu-p v)
 361         (unwind-protect
 362             (progn
 363               (menudiag-restore-window)
 364               (menudiag-select-internal v)
 365               (menudiag-redraw))
 366           (if (consp value)
 367               (setq value (cons item value)))
 368           (if done (menudiag-exit-minibuffer)))
 369       (if (eq value t)
 370           (setq value (menudiag-item-value item))
 371         (setq value (cons item nil)))
 372       (setq done t)
 373       (menudiag-exit-minibuffer))))
 374 \f
 375 (defconst menudiag-selection-map
 376   (let ((map (make-sparse-keymap)))
 377     (define-key map [right]   'next-completion)
 378     (define-key map [left]    'previous-completion)
 379     (define-key map "\r"      'menudiag-choose-item)
 380     (define-key map [mouse-2] 'menudiag-mouse-choose-item)
 381     map))
 382
 383 (defvar menudiag-selection-buffer nil)
 384 (make-variable-buffer-local 'menudiag-selection-buffer)
 385 (put 'menudiag-selection-buffer 'permanent-local t)
 386
 387 (defvar menudiag-selection-main-buffer nil)
 388 (make-variable-buffer-local 'menudiag-selection-main-buffer)
 389 (put 'menudiag-selection-main-buffer 'permanent-local t)
 390
 391 (defun menudiag-selection-mode ()
 392   (interactive)
 393   (kill-all-local-variables)
 394   (make-local-variable 'inhibit-read-only)
 395   (setq buffer-read-only t
 396         inhibit-read-only nil)
 397   (use-local-map menudiag-selection-map)
 398   (setq mode-name "Menudiag Selection")
 399   (setq major-mode 'menudiag-selection-mode))
 400
 401 (defun menudiag-max-item-width (item-list)
 402   (let ((max 0))
 403     (while item-list
 404       (setq max (max max (menudiag-item-width (car item-list)))
 405             item-list (cdr item-list)))
 406     max))
 407
 408 (defun menudiag-buffer-show-function ()
 409   (let* ((items current-items)
 410          (digits (length (concat (length items))))
 411          (columns (max 1 (/ (window-width (minibuffer-window))
 412                             (+ digits (menudiag-max-item-width items)))))
 413          (width (/ (window-width (minibuffer-window)) columns))
 414          (col 0) (n 0) str)
 415     (insert " ")
 416     (while items
 417       (setq p (point)
 418             str (format (concat "%" digits "d. %s")
 419                         n (menudiag-item-string (car items))))
 420       (insert str)
 421       (set-text-properties p (point) '(mouse-face highlight))
 422       (setq col (1+ col)
 423             n (1+ n)
 424             items (cdr items))
 425       (if items
 426           (if (/= col columns)
 427               (insert (make-string (- width (string-width str)) ?\ ))
 428             (insert "\n ")
 429             (setq col 0))))
 430     (goto-char (point-min))
 431     (set-buffer-modified-p nil)
 432     (menudiag-selection-mode)))
 433
 434 (defun menudiag-buffer-name (prompt)
 435   (let ((len (1- (length prompt))))
 436     (if (= (aref prompt len) ?:) (substring prompt 0 len) prompt)))
 437
 438 (defun menudiag-list-other-window ()
 439   (interactive)
 440   (let ((temp-buffer-show-hook 'menudiag-buffer-show-function)
 441         (main-buf (current-buffer)))
 442     (setq menudiag-window-conf (current-window-configuration))
 443     (with-output-to-temp-buffer (menudiag-buffer-name minibuf-prompt)
 444       (setq menudiag-selection-buffer standard-output))
 445     (set-buffer menudiag-selection-buffer)
 446     (setq menudiag-selection-main-buffer main-buf)))
 447
 448 (defun menudiag-choose-item ()
 449   (interactive)
 450   (let ((org-buf menudiag-selection-main-buffer)
 451         (sel-buf (current-buffer))
 452         (item-list selection-list)
 453         (l 0)
 454         tmp-buf n)
 455     (with-temp-buffer
 456       (setq tmp-buf (current-buffer))
 457       (set-buffer sel-buf)
 458       (setq completion-reference-buffer tmp-buf)
 459       (choose-completion)
 460       (set-buffer tmp-buf)
 461       (setq n (string-to-int (buffer-string))))
 462     (pop-to-buffer org-buf)
 463     (while (and item-list (>= (- n (length (car item-list))) 0))
 464       (setq l (1+ l)
 465             n (- n (length (car item-list)))
 466             item-list (cdr item-list)))
 467     (menudiag-goto-line l)
 468     (menudiag-goto-item-internal n)
 469     (menudiag-select-this-item)))
 470
 471 (defun menudiag-mouse-choose-item (event)
 472   (interactive "e")
 473   (set-buffer (window-buffer (car (nth 1 event))))
 474   (let ((org-buf menudiag-selection-main-buffer)
 475         (sel-buf (current-buffer))
 476         (item-list selection-list)
 477         (l 0)
 478         tmp-buf n)
 479     (with-temp-buffer
 480       (setq tmp-buf (current-buffer))
 481       (set-buffer sel-buf)
 482       (setq completion-reference-buffer tmp-buf)
 483       (mouse-choose-completion event)
 484       (set-buffer tmp-buf)
 485       (setq n (string-to-int (buffer-string))))
 486     (pop-to-buffer org-buf)
 487     (while (and item-list (>= (- n (length (car item-list))) 0))
 488       (setq l (1+ l)
 489             n (- n (length (car item-list)))
 490             item-list (cdr item-list)))
 491     (menudiag-goto-line l)
 492     (menudiag-goto-item-internal n)
 493     (menudiag-select-this-item)))
 494
 495 (defun menudiag-restore-window ()
 496   (if menudiag-window-conf
 497       (progn
 498         (set-window-configuration menudiag-window-conf)
 499         (setq menudiag-window-conf nil)
 500         (kill-buffer menudiag-selection-buffer))))
 501
 502 (defun menudiag-exit-minibuffer ()
 503   (and menudiag-window-conf (menudiag-restore-window))
 504   (exit-minibuffer))
 505
 506 (provide 'menudiag)
 507 ;;; menudiag.el ends here.