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 Tamago 4."
  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     (setq ch ?\C-0)
  76     (while (<= ch ?\C-9)
  77       (define-key map (vector ch) 'digit-argument)
  78       (setq ch (1+ ch)))
  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)
 103     map)
 104   "Keymap for MENU.")
 105
 106 (defun menudiag-menu-p (item)
 107   (and (consp item) (eq 'menu (car item))))
 108
 109 (defun menudiag-item-string (item)
 110   (if (stringp item)
 111       item
 112     (format "%s" (car item))))
 113
 114 (defun menudiag-item-value (item)
 115   (if (stringp item)
 116       item
 117     (cdr item)))
 118
 119 (defsubst menudiag-item-width (item)
 120   (+ 4 (string-width (menudiag-item-string item))))
 121
 122 (defun menudiag-make-selection-list (item-list line-width)
 123   (let ((l nil)
 124         (line nil)
 125         (width 0)
 126         (i 0))
 127     (while item-list
 128       (let* ((item (car item-list))
 129              (item-width (menudiag-item-width item)))
 130         (if (and line (or (>= (+ width item-width) line-width)
 131                           (>= i 36)))
 132             (setq l (cons (reverse line) l)
 133                   line nil
 134                   width 0
 135                   i 0))
 136         (setq line (cons item line)
 137               width (+ width (menudiag-item-width item))
 138               i (1+ i)
 139               item-list (cdr item-list))))
 140     (if line
 141         (reverse (cons (reverse line) l))
 142       (reverse l))))
 143
 144 (defvar menudiag-show-all nil)
 145 (make-variable-buffer-local 'menudiag-show-all)
 146
 147 (defvar menudiag-continuation nil)
 148 (make-variable-buffer-local 'menudiag-continuation)
 149
 150 (defvar menudiag-return-contin nil)
 151 (make-variable-buffer-local 'menudiag-return-contin)
 152
 153 (defvar menudiag-value nil)
 154 (make-variable-buffer-local 'menudiag-value)
 155
 156 (defvar menudiag-done nil)
 157 (make-variable-buffer-local 'menudiag-done)
 158
 159 ;; Entry function
 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)
 165         menudiag-value
 166       (signal 'quit ""))))
 167
 168 (defvar menudiag-line nil)
 169 (make-variable-buffer-local 'menudiag-line)
 170
 171 (defvar menudiag-linepos 0)
 172 (make-variable-buffer-local 'menudiag-linepos)
 173
 174 (defvar menudiag-pos-in-line 0)
 175 (make-variable-buffer-local 'menudiag-pos-in-line)
 176
 177 (defun menudiag-follow-continuation ()
 178   (let* ((item (car menudiag-continuation))
 179          (value (menudiag-item-value item))
 180          (pos (menudiag-search-item item)))
 181     (unless pos
 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
 187                                 menudiag-show-all
 188                                 (cdr menudiag-continuation))
 189       (menudiag-redraw)
 190       (when menudiag-done
 191         (when menudiag-return-contin
 192           (setq menudiag-value (cons item menudiag-value)))
 193         (setq unread-command-events (cons 'exit unread-command-events))))))
 194
 195 (defvar menudiag-minibuffer-list nil)
 196 (defvar menudiag-variable-alist nil)
 197
 198 (defmacro menudiag-send-variables (&rest args)
 199   `(setq menudiag-variable-alist
 200          (list ,@(mapcar (lambda (var) `(cons ',var ,var)) args))))
 201
 202 (defmacro menudiag-send-variables-with-value (&rest args)
 203   `(setq menudiag-variable-alist
 204          ,(let ((alist (list 'list)))
 205             (while args
 206               (nconc alist `((cons ',(car args) ,(cadr args))))
 207               (setq args (cddr args)))
 208             alist)))
 209
 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))))
 214
 215 (defvar menudiag-minibuf-prompt nil)
 216 (make-variable-buffer-local 'menudiag-minibuf-prompt)
 217
 218 (defvar menudiag-current-items nil)
 219 (make-variable-buffer-local 'menudiag-current-items)
 220
 221 (defvar menudiag-selection-list nil)
 222 (make-variable-buffer-local 'menudiag-selection-list)
 223
 224 (defun menudiag-minibuffer-hook ()
 225   (interactive)
 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)))
 236
 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
 246                             (car (cddr menu))
 247                             (- (window-width (minibuffer-window))
 248                                (string-width (cadr menu)))))
 249   (add-hook 'minibuffer-setup-hook 'menudiag-minibuffer-hook)
 250   (unwind-protect
 251       (progn
 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
 257     (save-excursion
 258       (goto-char (point-min)))))
 259
 260 (defun menudiag-make-menu-formatted-string (item-list)
 261   (let ((i -1))
 262     (mapconcat
 263      (function (lambda (item)
 264                  (setq i (1+ i))
 265                  (format "  %c.%s" (menudiag-item-num-to-char i)
 266                            (menudiag-item-string item))))
 267      item-list "")))
 268
 269
 270 ;; ITEM No --> Character
 271 (defun menudiag-item-num-to-char (num)
 272   (let ((char))
 273     (cond ((<= num 9)
 274            (setq char (+ ?0 num)))
 275           (t
 276            (setq char (+ ?a (- num 10))))
 277           )
 278     char))
 279
 280 ;; Character --> ITEM No
 281 (defun menudiag-char-to-item-num (ch)
 282   (let ((num))
 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))))
 289           (t (setq num 1000)))
 290     num))
 291
 292 (defun menudiag-check-current-menu ()
 293   (or (eq (current-buffer) (car menudiag-minibuffer-list))
 294       (error "menudiag: not current menu")))
 295
 296 (defun menudiag-goto-item ()
 297   (interactive)
 298   (menudiag-check-current-menu)
 299   (let ((ch last-command-char)
 300         (n 0))
 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)))))
 307
 308 (defun menudiag-goto-item-internal (n)
 309   (let ((p (+ (length menudiag-minibuf-prompt) 3))
 310         (i 0))
 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))
 314       (setq i (1+ i)))
 315     (goto-char p)))
 316
 317 (defun menudiag-beginning-of-items ()
 318   (interactive)
 319   (menudiag-check-current-menu)
 320   (menudiag-goto-line 0)
 321   (menudiag-beginning-of-line))
 322
 323 (defun menudiag-end-of-items ()
 324   (interactive)
 325   (menudiag-check-current-menu)
 326   (menudiag-goto-line (1- (length menudiag-selection-list)))
 327   (menudiag-end-of-line))
 328
 329 (defun menudiag-beginning-of-line ()
 330   (interactive)
 331   (menudiag-check-current-menu)
 332   (menudiag-goto-item-internal 0))
 333
 334 (defun menudiag-end-of-line ()
 335   (interactive)
 336   (menudiag-check-current-menu)
 337   (menudiag-goto-item-internal (1- (length menudiag-line))))
 338
 339 ;; Should retain compatibility.  Must.
 340 ;;
 341 ;;(defun menudiag-forward-item ()
 342 ;;  (interactive)
 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))))
 349 ;;
 350 ;;(defun menudiag-backward-item ()
 351 ;;  (interactive)
 352 ;;  (if (< 0 pos-in-line)
 353 ;;      (menudiag-goto-item-internal (1- pos-in-line))
 354 ;;    (if (< linepos 1)
 355 ;;      (signal 'beginning-of-buffer "")
 356 ;;      (menudiag-goto-line (1- linepos))
 357 ;;      (menudiag-end-of-line))))
 358 ;;
 359 ;;(defun menudiag-goto-line (n)
 360 ;;  (if (or (>= n (length selection-list)) (< n 0))
 361 ;;      (ding)
 362 ;;    (setq line (nth n selection-list)
 363 ;;        linepos n)
 364 ;;    (delete-region (point-min) (point-max))
 365 ;;    (insert (menudiag-make-menu-formatted-string line))))
 366 ;;
 367
 368 (defun menudiag-forward-item (n)
 369   (interactive "p")
 370   (menudiag-forward-item-internal n))
 371
 372 (defun menudiag-backward-item (n)
 373   (interactive "p")
 374   (menudiag-forward-item-internal (- n)))
 375
 376 (defun menudiag-forward-item-internal (n)
 377   (menudiag-check-current-menu)
 378   (setq n (+ n menudiag-pos-in-line))
 379   (while (< n 0)
 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))
 386
 387 (defun menudiag-goto-line (n)
 388   (let ((len (length menudiag-selection-list)))
 389     (when (< n 0)
 390       (setq n (+ (% n len) len)))
 391     (when (>= n len)
 392       (setq n (% n len)))
 393     (setq menudiag-line (nth n menudiag-selection-list)
 394           menudiag-linepos n)
 395     (let ((inhibit-read-only t))
 396       (erase-buffer)
 397       (insert menudiag-minibuf-prompt
 398               (menudiag-make-menu-formatted-string menudiag-line))
 399       (set-text-properties (point-min) (point-max) '(read-only t)))))
 400
 401 (defun menudiag-next-line (n)
 402   (interactive "p")
 403   (menudiag-next-line-internal n))
 404
 405 (defun menudiag-previous-line (n)
 406   (interactive "p")
 407   (menudiag-next-line-internal (- n)))
 408
 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)))
 415
 416 (defun menudiag-redraw ()
 417   (interactive)
 418   (menudiag-check-current-menu)
 419   (menudiag-goto-line menudiag-linepos)
 420   (menudiag-goto-item-internal menudiag-pos-in-line))
 421
 422 (defun menudiag-exit-one-level ()
 423   (interactive)
 424   (menudiag-check-current-menu)
 425   (menudiag-exit-minibuffer))
 426
 427 (defun menudiag-exit ()
 428   (interactive)
 429   (menudiag-check-current-menu)
 430   (unless menudiag-done
 431     (setq menudiag-done 'quit))
 432   (menudiag-exit-minibuffer))
 433
 434 (defun menudiag-select-this-item (&optional all)
 435   (interactive)
 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)
 440         (progn
 441           (menudiag-restore-window)
 442           (menudiag-select-internal v all)
 443           (menudiag-redraw)
 444           (cond (menudiag-done
 445                  (when menudiag-return-contin
 446                    (setq menudiag-value (cons item menudiag-value)))
 447                  (menudiag-exit-minibuffer))
 448                 (all
 449                  (menudiag-list-other-window))))
 450       (setq menudiag-value (if menudiag-return-contin
 451                                (list item)
 452                              (menudiag-item-value item))
 453             menudiag-done t)
 454       (menudiag-exit-minibuffer))))
 455
 456 (defun menudiag-search-item (item)
 457   (let ((selection-list menudiag-selection-list)
 458         (line 0)
 459         rest)
 460     (while (and selection-list
 461                 (null (setq rest (memq item (car selection-list)))))
 462       (setq selection-list (cdr selection-list)
 463             line (1+ line)))
 464     (and selection-list
 465          (cons line (- (length (car selection-list)) (length rest))))))
 466 \f
 467 (defconst menudiag-selection-map
 468   (let ((map (make-sparse-keymap))
 469         (ch ?0))
 470     (while (<= ch ?9)
 471       (define-key map (char-to-string ch) 'menudiag-selection-goto)
 472       (setq ch (1+ ch)))
 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)
 489     map)
 490   "keymap for menu selection mode")
 491
 492 (defvar menudiag-window-conf nil)
 493 (make-variable-buffer-local 'menudiag-window-conf)
 494
 495 (defvar menudiag-selection-buffer nil)
 496 (make-variable-buffer-local 'menudiag-selection-buffer)
 497
 498 (defvar menudiag-selection-main-buffer nil)
 499 (make-variable-buffer-local 'menudiag-selection-main-buffer)
 500
 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))
 511
 512 (defun menudiag-max-item-width (items)
 513   (apply 'max (mapcar 'menudiag-item-width items)))
 514
 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))
 523          (col 0) (n 0) str p)
 524     (insert " ")
 525     (while items
 526       (setq p (point)
 527             str (format form n (menudiag-item-string (car items))))
 528       (insert str)
 529       (set-text-properties p (point) '(mouse-face highlight))
 530       (setq col (1+ col)
 531             n (1+ n)
 532             items (cdr items))
 533       (if items
 534           (if (/= col columns)
 535               (insert (make-string (- width (string-width str)) ?\ ))
 536             (insert "\n ")
 537             (setq col 0))))
 538     (goto-char (point-min))
 539     (set-buffer-modified-p nil)
 540     (menudiag-selection-mode)))
 541
 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))))
 546
 547 (defun menudiag-list-other-window ()
 548   (interactive)
 549   (menudiag-check-current-menu)
 550   (let ((window (and menudiag-selection-buffer
 551                      (get-buffer-window menudiag-selection-buffer))))
 552     (if window
 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)
 567         (while (> linepos 0)
 568           (setq linepos (1- linepos)
 569                 n (+ n (length (car selection-list)))
 570                 selection-list (cdr selection-list)))
 571         (next-completion n)))))
 572
 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")))
 576
 577 (defun menudiag-choose-item ()
 578   (interactive)
 579   (menudiag-choose-item-internal nil))
 580
 581 (defun menudiag-mouse-choose-item (event)
 582   (interactive "e")
 583   (set-buffer (window-buffer (caadr event)))
 584   (menudiag-choose-item-internal event))
 585
 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)
 591         (l 0)
 592         tmp-buf n)
 593     (with-temp-buffer
 594       (setq tmp-buf (current-buffer))
 595       (set-buffer sel-buf)
 596       (setq completion-reference-buffer tmp-buf)
 597       (if event
 598           (mouse-choose-completion event)
 599         (choose-completion))
 600       (set-buffer tmp-buf)
 601       (setq n (string-to-int (buffer-string))))
 602     (pop-to-buffer org-buf)
 603     (while (and item-list (>= n (length (car item-list))))
 604       (setq l (1+ l)
 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)))
 610
 611 (defvar menudiag-goto-number-list nil)
 612 (make-variable-buffer-local 'menudiag-goto-number-list)
 613
 614 (defvar menudiag-original-point nil)
 615 (make-variable-buffer-local' menudiag-original-point)
 616
 617 (defun menudiag-selection-goto ()
 618   (interactive)
 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))
 625
 626 (defun menudiag-selection-goto-internal ()
 627   (let* ((list menudiag-goto-number-list)
 628          (n (menudiag-selection-item-number list))
 629          (len (save-excursion
 630                 (set-buffer menudiag-selection-main-buffer)
 631                 (length menudiag-current-items))))
 632     (setq this-command 'menudiag-selection-goto)
 633     (if (>= n len)
 634         (progn
 635           (ding)
 636           (setq menudiag-goto-number-list (cdr list)))
 637     (goto-char (point-min))
 638     (next-completion (1+ n)))))
 639
 640 (defun menudiag-selection-item-number (list)
 641   (let ((n 0)
 642         (exp 1))
 643     (while list
 644       (setq n (+ (* (car list) exp) n)
 645             exp (* 10 exp)
 646             list (cdr list)))
 647     n))
 648
 649 (defun menudiag-selection-goto-delete (n)
 650   (interactive "p")
 651   (if (null (eq last-command 'menudiag-selection-goto))
 652       (ding)
 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))))
 657
 658 (defun menudiag-selection-align-to-item ()
 659   (cond ((bolp)
 660          (next-completion 1))
 661         ((get-text-property (1- (point)) 'mouse-face)
 662          (goto-char (previous-single-property-change (point) 'mouse-face)))))
 663
 664 (defun menudiag-restore-window ()
 665   (when menudiag-window-conf
 666     (set-window-configuration menudiag-window-conf)
 667     (kill-buffer menudiag-selection-buffer)))
 668
 669 (defun menudiag-exit-minibuffer ()
 670   (menudiag-restore-window)
 671   (menudiag-send-variables menudiag-done menudiag-value)
 672   (buffer-enable-undo)
 673   (exit-minibuffer))
 674
 675 (defun menudiag-retun-to-minibuf ()
 676   (interactive)
 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)))
 681     (if window
 682         (select-window window)
 683       (error "menudiag: cannot find minibuffer"))))
 684
 685 (defun menudiag-selection-exit-one-level ()
 686   (interactive)
 687   (set-buffer menudiag-selection-main-buffer)
 688   (menudiag-exit-one-level))
 689
 690 (defun menudiag-selection-exit ()
 691   (interactive)
 692   (set-buffer menudiag-selection-main-buffer)
 693   (menudiag-exit))
 694
 695 (provide 'menudiag)
 696 ;;; menudiag.el ends here.