menudiag.el

   1 ;;; menudiag.el --- Minibuffer Menu System
   2
   3 ;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical
   4 ;; Laboratory, JAPAN.
   5 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
   6
   7 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
   8 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
   9
  10 ;; This file will be part of GNU Emacs (in future).
  11
  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)
  15 ;; any later version.
  16
  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.
  21
  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.
  26
  27 ;;; Commentary:
  28 ;; Inspired by the menu subsystem of EGG V3.0
  29 ;;
  30 ;; Completely different implementation, using keymap and recursive edit.
  31
  32 ;;; Code:
  33
  34 ;;
  35 ;; Data structure of MENU
  36 ;;
  37 ;; <menu> ::= ( menu <prompt> <item-list> )
  38 ;; <prompt> ::= STRING
  39 ;; <item-list> ::= ( <item> ... )
  40 ;; <item> ::= <string> | ( <string> . <value> )
  41 ;;
  42 ;; <value> ::=  <menu> | INTEGER | STRING  (Must *NOT* cons cell)
  43 ;;
  44 ;;
  45 ;
  46 ;;
  47 ;; <selection-list> ::= ( <line>... )
  48 ;; <line>  ::= ( <item>... )
  49 ;;
  50
  51 (defvar menudiag-mode-map
  52   (let ((map (make-keymap))
  53         (ch 0))
  54     (while (< ch 27)
  55       (define-key map (char-to-string ch) 'undefined)
  56       (setq ch (1+ ch)))
  57     (setq ch 28)
  58     (while (< ch 255)
  59       (define-key map (char-to-string ch) 'undefined)
  60       (setq ch (1+ ch)))
  61     (setq ch ?0)
  62     (while (<= ch ?9)
  63       (define-key map (char-to-string ch) 'menudiag-goto-item)
  64       (setq ch (1+ ch)))
  65     (setq ch ?a)
  66     (while (<= ch ?z)
  67       (define-key map (char-to-string ch) 'menudiag-goto-item)
  68       (setq ch (1+ ch)))
  69     (setq ch ?A)
  70     (while (<= ch ?Z)
  71       (define-key map (char-to-string ch) 'menudiag-goto-item)
  72       (setq ch (1+ ch)))
  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)
  91     map)
  92   "Keymap for MENU.")
  93
  94 (defun menudiag-menu-p (item)
  95   (and (consp item) (eq 'menu (car item))))
  96
  97 (defun menudiag-item-string (item)
  98   (if (stringp item)
  99       item
 100     (format "%s" (car item))))
 101
 102 (defun menudiag-item-value (item)
 103   (if (stringp item)
 104       item
 105     (cdr item)))
 106
 107 (defsubst menudiag-item-width (item)
 108   (+ 4 (string-width (menudiag-item-string item))))
 109
 110 (defun menudiag-make-selection-list (item-list line-width)
 111   (let ((l nil)
 112         (line nil)
 113         (width 0)
 114         (i 0))
 115     (while item-list
 116       (let* ((item (car item-list))
 117              (item-width (menudiag-item-width item)))
 118         (if (and line (or (>= (+ width item-width) line-width)
 119                           (>= i 36)))
 120             (setq l (cons (reverse line) l)
 121                   line nil
 122                   width 0
 123                   i 0))
 124         (setq line (cons item line)
 125               width (+ width (menudiag-item-width item))
 126               i (1+ i)
 127               item-list (cdr item-list))))
 128     (if line
 129         (reverse (cons (reverse line) l))
 130       (reverse l))))
 131
 132 ;; Entry function
 133 (defun menudiag-select (menu &optional menudiag-continuation return-contin)
 134   (let (value)
 135     (if menudiag-continuation
 136         (setq unread-command-events (cons 'menudiag-continuation
 137                                           unread-command-events)))
 138     (if (not return-contin)
 139         (setq value t))
 140     (if (catch 'menudiag-exit
 141           (menudiag-select-internal menu))
 142         (signal 'quit "")
 143       value)))
 144
 145 ;; Entry function
 146 (defun menudiag-get-value (continuation)
 147   (menudiag-item-value (nth (1- (length continuation)) continuation)))
 148
 149 (defun menudiag-follow-continuation ()
 150   (interactive)
 151   (let ((item (car menudiag-continuation)))
 152     (setq menudiag-continuation (cdr menudiag-continuation))
 153     (if menudiag-continuation
 154         (setq unread-command-events (cons 'menudiag-continuation
 155                                           unread-command-events)))
 156     (let ((in-loop t))
 157       (while in-loop
 158         (if (eq item (nth pos-in-line line))
 159             (setq in-loop nil)
 160           (menudiag-forward-item))))
 161     (let ((v (menudiag-item-value item)))
 162       (if (menudiag-menu-p v)
 163           (unwind-protect
 164               (progn
 165                 (menudiag-select-internal v)
 166                 (menudiag-redraw))
 167             (if (consp value)
 168                 (setq value (cons item value))))))))
 169
 170 (defun menudiag-select-internal (menu)
 171   (let* ((minibuf-prompt (nth 1 menu))
 172          (selection-list
 173           (menudiag-make-selection-list (nth 2 menu)
 174                                     (- (window-width (minibuffer-window))
 175                                        (string-width minibuf-prompt))))
 176          (line (car selection-list))
 177          (minibuf-contents
 178           (menudiag-make-menu-formatted-string line)))
 179     (let ((linepos 0)
 180           (pos-in-line 0))
 181       (read-from-minibuffer minibuf-prompt
 182                             (cons minibuf-contents 3)
 183                             menudiag-mode-map))))
 184
 185 (defun menudiag-make-menu-formatted-string (item-list)
 186   (let ((i -1))
 187     (mapconcat
 188      (function (lambda (item)
 189                  (setq i (1+ i))
 190                  (format "  %c.%s" (menudiag-item-num-to-char i)
 191                            (menudiag-item-string item))))
 192      item-list "")))
 193
 194
 195 ;; ITEM No --> Character
 196 (defun menudiag-item-num-to-char (num)
 197   (let ((char))
 198     (cond ((<= num 9)
 199            (setq char (+ ?0 num)))
 200           (t
 201            (setq char (+ ?a (- num 10))))
 202           )
 203     char))
 204
 205 ;; Character --> ITEM No
 206 (defun menudiag-char-to-item-num (char)
 207   (let ((num))
 208     (cond ((and (<= ?0 ch) (<= ch ?9))
 209            (setq num (- ch ?0)))
 210           ((and (<= ?a ch) (<= ch ?z))
 211            (setq num (+ 10 (- ch ?a))))
 212           ((and (<= ?A ch) (<= ch ?Z))
 213            (setq num (+ 10 (- ch ?A))))
 214           (t (setq num 1000)))
 215     num))
 216
 217
 218 (defun menudiag-goto-item ()
 219   (interactive)
 220   (let ((ch last-command-char)
 221         (n 0))
 222     (setq n (menudiag-char-to-item-num ch))
 223     (if (>= n (length line))
 224         (error "No such item")
 225       (menudiag-goto-item-internal n))))
 226
 227 (defun menudiag-goto-item-internal (n)
 228   (let ((old-pos-in-line pos-in-line)
 229         (p 3)
 230         (i 0))
 231     (setq pos-in-line n)
 232     (while (< i pos-in-line)
 233       (setq p (+ p (length (menudiag-item-string (nth i line))) 4))
 234       (setq i (1+ i)))
 235     (goto-char p)))
 236
 237 (defun menudiag-beginning-of-items ()
 238   (interactive)
 239   (menudiag-goto-line 0)
 240   (menudiag-beginning-of-line))
 241
 242 (defun menudiag-end-of-items ()
 243   (interactive)
 244   (menudiag-goto-line (1- (length selection-list)))
 245   (menudiag-end-of-line))
 246
 247 (defun menudiag-beginning-of-line ()
 248   (interactive)
 249   (menudiag-goto-item-internal 0))
 250
 251 (defun menudiag-end-of-line ()
 252   (interactive)
 253   (menudiag-goto-item-internal (1- (length line))))
 254
 255 ;; Should retain compatibility.  Must.
 256 ;;
 257 ;;(defun menudiag-forward-item ()
 258 ;;  (interactive)
 259 ;;  (if (< pos-in-line (1- (length line)))
 260 ;;      (menudiag-goto-item-internal (1+ pos-in-line))
 261 ;;    (if (>= linepos (1- (length selection-list)))
 262 ;;      (signal 'end-of-buffer "")
 263 ;;      (menudiag-goto-line (1+ linepos))
 264 ;;      (menudiag-beginning-of-line))))
 265 ;;
 266 ;;(defun menudiag-backward-item ()
 267 ;;  (interactive)
 268 ;;  (if (< 0 pos-in-line)
 269 ;;      (menudiag-goto-item-internal (1- pos-in-line))
 270 ;;    (if (< linepos 1)
 271 ;;      (signal 'beginning-of-buffer "")
 272 ;;      (menudiag-goto-line (1- linepos))
 273 ;;      (menudiag-end-of-line))))
 274 ;;
 275 ;;(defun menudiag-goto-line (n)
 276 ;;  (if (or (>= n (length selection-list)) (< n 0))
 277 ;;      (ding)
 278 ;;    (setq line (nth n selection-list)
 279 ;;        linepos n)
 280 ;;    (delete-region (point-min) (point-max))
 281 ;;    (insert (menudiag-make-menu-formatted-string line))))
 282 ;;
 283
 284 (defun menudiag-forward-item ()
 285   (interactive)
 286   (if (< pos-in-line (1- (length line)))
 287       (menudiag-goto-item-internal (1+ pos-in-line))
 288     (if (>= linepos (1- (length selection-list)))
 289         (menudiag-goto-line 0)
 290       (menudiag-goto-line (1+ linepos)))
 291     (menudiag-beginning-of-line)))
 292
 293 (defun menudiag-backward-item ()
 294   (interactive)
 295   (if (< 0 pos-in-line)
 296       (menudiag-goto-item-internal (1- pos-in-line))
 297     (if (< linepos 1)
 298         (menudiag-goto-line (1- (length selection-list)))
 299       (menudiag-goto-line (1- linepos)))
 300     (menudiag-end-of-line)))
 301
 302 (defun menudiag-goto-line (n)
 303   (cond
 304    ((>= n (length selection-list))
 305     (setq n 0))
 306    ((< n 0)
 307     (setq n (1- (length selection-list)))))
 308   (setq line (nth n selection-list)
 309         linepos n)
 310   (delete-region (point-min) (point-max))
 311   (insert (menudiag-make-menu-formatted-string line)))
 312
 313 (defun menudiag-next-line ()
 314   (interactive)
 315   (menudiag-goto-line (1+ linepos))
 316   (if (< pos-in-line (length line))
 317       (menudiag-goto-item-internal pos-in-line)
 318     (menudiag-end-of-line)))
 319
 320 (defun menudiag-previous-line ()
 321   (interactive)
 322   (menudiag-goto-line (1- linepos))
 323   (if (< pos-in-line (length line))
 324       (menudiag-goto-item-internal pos-in-line)
 325     (menudiag-end-of-line)))
 326
 327 (defun menudiag-redraw ()
 328   (interactive)
 329   (menudiag-goto-line linepos)
 330   (menudiag-goto-item-internal pos-in-line))
 331
 332 (defun menudiag-exit-one-level ()
 333   (interactive)
 334   (exit-minibuffer))
 335
 336 (defun menudiag-exit ()
 337   (interactive)
 338   (throw 'menudiag-exit t))
 339
 340 (defun menudiag-select-this-item ()
 341   (interactive)
 342   (let* ((item (nth pos-in-line line))
 343          (v (menudiag-item-value item)))
 344     (if (menudiag-menu-p v)
 345         (unwind-protect
 346             (progn
 347               (menudiag-select-internal v)
 348               (menudiag-redraw))
 349           (if (consp value)
 350               (setq value (cons item value))))
 351       (if (eq value t)
 352           (setq value (menudiag-item-value item))
 353         (setq value (cons item nil)))
 354       (throw 'menudiag-exit nil))))
 355
 356 (provide 'menudiag)
 357 ;;; menudiag.el ends here.