;;; menudiag.el --- Minibuffer Menu System

;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical
;; Laboratory, JAPAN.
;; Project Leader: Satoru Tomura <tomura@etl.go.jp>

;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>

;; This file will be part of GNU Emacs (in future).

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;; Inspired by the menu subsystem of EGG V3.0
;;
;; Completely different implementation, using keymap and recursive edit.

;;; Code:

;;
;; Data structure of MENU
;;
;; <menu> ::= ( menu <prompt> <item-list> )
;; <prompt> ::= STRING
;; <item-list> ::= ( <item> ... )
;; <item> ::= <string> | ( <string> . <value> )
;;
;; <value> ::=  <menu> | INTEGER | STRING  (Must *NOT* cons cell)
;;
;;
;
;;
;; <selection-list> ::= ( <line>... )
;; <line>  ::= ( <item>... )
;;

(defvar menudiag-mode-map
  (let ((map (make-keymap))
	(ch 0))
    (while (< ch 27)
      (define-key map (char-to-string ch) 'undefined)
      (setq ch (1+ ch)))
    (setq ch 28)
    (while (< ch 255)
      (define-key map (char-to-string ch) 'undefined)
      (setq ch (1+ ch)))
    (setq ch ?0)
    (while (<= ch ?9)
      (define-key map (char-to-string ch) 'menudiag-goto-item)
      (setq ch (1+ ch)))
    (setq ch ?a)
    (while (<= ch ?z)
      (define-key map (char-to-string ch) 'menudiag-goto-item)
      (setq ch (1+ ch)))
    (setq ch ?A)
    (while (<= ch ?Z)
      (define-key map (char-to-string ch) 'menudiag-goto-item)
      (setq ch (1+ ch)))
    (define-key map "\C-a" 'menudiag-beginning-of-line)
    (define-key map "\C-e" 'menudiag-end-of-line)
    (define-key map "\M-<" 'menudiag-beginning-of-items)
    (define-key map "\M->" 'menudiag-end-of-items)
    (define-key map "\C-f" 'menudiag-forward-item)
    (define-key map "\C-b" 'menudiag-backward-item)
    (define-key map "\C-n" 'menudiag-next-line)
    (define-key map "\C-p" 'menudiag-previous-line)
    (define-key map "\C-]" 'menudiag-exit)
    (define-key map "\C-g" 'menudiag-exit-one-level)
    (define-key map "\C-l" 'menudiag-redraw)
    (define-key map "\C-m" 'menudiag-select-this-item)
    (define-key map [return] 'menudiag-select-this-item)
    (define-key map [left] 'menudiag-backward-item)
    (define-key map [right] 'menudiag-forward-item)
    (define-key map [up] 'menudiag-previous-line)
    (define-key map [down] 'menudiag-next-line)
    (define-key map [menudiag-continuation] 'menudiag-follow-continuation)
    map)
  "Keymap for MENU.")

(defun menudiag-menu-p (item)
  (and (consp item) (eq 'menu (car item))))

(defun menudiag-item-string (item)
  (if (stringp item)
      item
    (format "%s" (car item))))

(defun menudiag-item-value (item)
  (if (stringp item)
      item
    (cdr item)))

(defsubst menudiag-item-width (item)
  (+ 4 (string-width (menudiag-item-string item))))

(defun menudiag-make-selection-list (item-list line-width)
  (let ((l nil)
	(line nil)
	(width 0)
	(i 0))
    (while item-list
      (let* ((item (car item-list))
	     (item-width (menudiag-item-width item)))
	(if (and line (or (>= (+ width item-width) line-width)
                          (>= i 36)))
	    (setq l (cons (reverse line) l)
		  line nil
		  width 0
		  i 0))
	(setq line (cons item line)
	      width (+ width (menudiag-item-width item))
	      i (1+ i)
	      item-list (cdr item-list))))
    (if line
	(reverse (cons (reverse line) l))
      (reverse l))))

;; Entry function
(defun menudiag-select (menu &optional menudiag-continuation return-contin)
  (let (value)
    (if menudiag-continuation
	(setq unread-command-events (cons 'menudiag-continuation
					  unread-command-events)))
    (if (not return-contin)
	(setq value t))
    (if (catch 'menudiag-exit
	  (menudiag-select-internal menu))
	(signal 'quit "")
      value)))

;; Entry function
(defun menudiag-get-value (continuation)
  (menudiag-item-value (nth (1- (length continuation)) continuation)))

(defun menudiag-follow-continuation ()
  (interactive)
  (let ((item (car menudiag-continuation)))
    (setq menudiag-continuation (cdr menudiag-continuation))
    (if menudiag-continuation
	(setq unread-command-events (cons 'menudiag-continuation
					  unread-command-events)))
    (let ((in-loop t))
      (while in-loop
	(if (eq item (nth pos-in-line line))
	    (setq in-loop nil)
	  (menudiag-forward-item))))
    (let ((v (menudiag-item-value item)))
      (if (menudiag-menu-p v)
	  (unwind-protect
	      (progn
		(menudiag-select-internal v)
		(menudiag-redraw))
	    (if (consp value)
		(setq value (cons item value))))))))

(defun menudiag-select-internal (menu)
  (let* ((minibuf-prompt (nth 1 menu))
	 (selection-list
	  (menudiag-make-selection-list (nth 2 menu)
				    (- (window-width (minibuffer-window))
				       (string-width minibuf-prompt))))
	 (line (car selection-list))
	 (minibuf-contents
	  (menudiag-make-menu-formatted-string line)))
    (let ((linepos 0)
	  (pos-in-line 0))
      (read-from-minibuffer minibuf-prompt
			    (cons minibuf-contents 3)
			    menudiag-mode-map))))

(defun menudiag-make-menu-formatted-string (item-list)
  (let ((i -1))
    (mapconcat
     (function (lambda (item)
		 (setq i (1+ i))
		 (format "  %c.%s" (menudiag-item-num-to-char i) 
                           (menudiag-item-string item))))
     item-list "")))


;; ITEM No --> Character
(defun menudiag-item-num-to-char (num)
  (let ((char))
    (cond ((<= num 9)
           (setq char (+ ?0 num)))
          (t
           (setq char (+ ?a (- num 10))))
          )
    char))

;; Character --> ITEM No
(defun menudiag-char-to-item-num (char)
  (let ((num))
    (cond ((and (<= ?0 ch) (<= ch ?9))
           (setq num (- ch ?0)))
          ((and (<= ?a ch) (<= ch ?z))
           (setq num (+ 10 (- ch ?a))))
          ((and (<= ?A ch) (<= ch ?Z))
           (setq num (+ 10 (- ch ?A))))
          (t (setq num 1000)))
    num))


(defun menudiag-goto-item ()
  (interactive)
  (let ((ch last-command-char)
	(n 0))
    (setq n (menudiag-char-to-item-num ch))
    (if (>= n (length line))
	(error "No such item")
      (menudiag-goto-item-internal n))))

(defun menudiag-goto-item-internal (n)
  (let ((old-pos-in-line pos-in-line)
	(p 3)
	(i 0))
    (setq pos-in-line n)
    (while (< i pos-in-line)
      (setq p (+ p (length (menudiag-item-string (nth i line))) 4))
      (setq i (1+ i)))
    (goto-char p)))

(defun menudiag-beginning-of-items ()
  (interactive)
  (menudiag-goto-line 0)
  (menudiag-beginning-of-line))

(defun menudiag-end-of-items ()
  (interactive)
  (menudiag-goto-line (1- (length selection-list)))
  (menudiag-end-of-line))

(defun menudiag-beginning-of-line ()
  (interactive)
  (menudiag-goto-item-internal 0))

(defun menudiag-end-of-line ()
  (interactive)
  (menudiag-goto-item-internal (1- (length line))))

;; Should retain compatibility.  Must.
;;
;;(defun menudiag-forward-item ()
;;  (interactive)
;;  (if (< pos-in-line (1- (length line)))
;;      (menudiag-goto-item-internal (1+ pos-in-line))
;;    (if (>= linepos (1- (length selection-list)))
;;	(signal 'end-of-buffer "")
;;      (menudiag-goto-line (1+ linepos))
;;      (menudiag-beginning-of-line))))
;;
;;(defun menudiag-backward-item ()
;;  (interactive)
;;  (if (< 0 pos-in-line)
;;      (menudiag-goto-item-internal (1- pos-in-line))
;;    (if (< linepos 1)
;;	(signal 'beginning-of-buffer "")
;;      (menudiag-goto-line (1- linepos))
;;      (menudiag-end-of-line))))
;;
;;(defun menudiag-goto-line (n)
;;  (if (or (>= n (length selection-list)) (< n 0))
;;      (ding)
;;    (setq line (nth n selection-list)
;;	  linepos n)
;;    (delete-region (point-min) (point-max))
;;    (insert (menudiag-make-menu-formatted-string line))))
;;

(defun menudiag-forward-item ()
  (interactive)
  (if (< pos-in-line (1- (length line)))
      (menudiag-goto-item-internal (1+ pos-in-line))
    (if (>= linepos (1- (length selection-list)))
	(menudiag-goto-line 0)
      (menudiag-goto-line (1+ linepos)))
    (menudiag-beginning-of-line)))

(defun menudiag-backward-item ()
  (interactive)
  (if (< 0 pos-in-line)
      (menudiag-goto-item-internal (1- pos-in-line))
    (if (< linepos 1)
        (menudiag-goto-line (1- (length selection-list)))
      (menudiag-goto-line (1- linepos)))
    (menudiag-end-of-line)))

(defun menudiag-goto-line (n)
  (cond
   ((>= n (length selection-list))
    (setq n 0))
   ((< n 0)
    (setq n (1- (length selection-list)))))
  (setq line (nth n selection-list)
        linepos n)
  (delete-region (point-min) (point-max))
  (insert (menudiag-make-menu-formatted-string line)))

(defun menudiag-next-line ()
  (interactive)
  (menudiag-goto-line (1+ linepos))
  (if (< pos-in-line (length line))
      (menudiag-goto-item-internal pos-in-line)
    (menudiag-end-of-line)))

(defun menudiag-previous-line ()
  (interactive)
  (menudiag-goto-line (1- linepos))
  (if (< pos-in-line (length line))
      (menudiag-goto-item-internal pos-in-line)
    (menudiag-end-of-line)))

(defun menudiag-redraw ()
  (interactive)
  (menudiag-goto-line linepos)
  (menudiag-goto-item-internal pos-in-line))

(defun menudiag-exit-one-level ()
  (interactive)
  (exit-minibuffer))

(defun menudiag-exit ()
  (interactive)
  (throw 'menudiag-exit t))

(defun menudiag-select-this-item ()
  (interactive)
  (let* ((item (nth pos-in-line line))
	 (v (menudiag-item-value item)))
    (if (menudiag-menu-p v)
	(unwind-protect
	    (progn
	      (menudiag-select-internal v)
	      (menudiag-redraw))
	  (if (consp value)
	      (setq value (cons item value))))
      (if (eq value t)
	  (setq value (menudiag-item-value item))
	(setq value (cons item nil)))
      (throw 'menudiag-exit nil))))

(provide 'menudiag)
;;; menudiag.el ends here.