;;; lyskom-menu.el

(require 'lyskom)

(defvar show-lyskom-menu t
  "Show the LysKOM menu window.")

(defvar lyskom-menu-columns 4
  "*Number of columns in the LysKOM menu buffer.")

(defvar lyskom-menu-window-height 0
  "*Size of the LysKOM menu window.

See also lyskom-clock-window-max-height.")

(defvar lyskom-menu-window-max-height 10
  "*Maximum size of the LysKOM menu window.

The window is lyskom-menu-window-height lines high, but that variable
may not be higher than lyskom-menu-window-mac-height.")

(defvar lyskom-menu-window-width 0
  "The width of the LysKOM menu window")

(defvar lyskom-menu-mode-line ""
  "LysKOM menu name in the mode line.")

(defvar lyskom-menu-color nil
  "*Enable colors in the LysKOM menu buffer.

A value of nil turns colors off, and a non-nil value on.")
(if lyskom-menu-color nil
  (setq lyskom-menu-color (x-display-color-p)))

(defvar lyskom-menu-buffer nil)
(defvar lyskom-menu-window nil)

(make-face 'lyskom-menu-command-face)
(make-face 'lyskom-menu-menu-face)

(set-face-font 'lyskom-menu-menu-face (face-font 'bold))
(set-face-background 'lyskom-menu-menu-face "gray")

(defvar lyskom-current-menu nil
  "The current menu in the LysKOM menu buffer.")

(setq lyskom-menus
      '((lyskom-main-menu "Huvudmeny")
	(lyskom-edit-menu "Inställningar")
	(lyskom-review-menu "Återse")
	(lyskom-text-menu "Inlägg")
	(lyskom-other-menu "Övrigt")))

(setq lyskom-menu-commands
      '((kom-next-command "Nästa kommando")
	(kom-comment-previous "Kommentera förra")))

(setq lyskom-main-menu
      '("Huvudmeny"
	describe-mode kom-next-command
	kom-write-text kom-write-comment
	kom-private-answer kom-list-news
	kom-go-to-conf kom-go-to-next-conf
	kom-comment-previous kom-quit
	kom-view-next-text kom-send-message
	lyskom-edit-menu lyskom-review-menu
	lyskom-text-menu lyskom-other-menu
	))

(setq lyskom-edit-menu
      '("Inställningar"
	kom-change-presentation kom-change-name
	kom-change-password kom-edit-options
	kom-prioritize nil nil nil
	nil nil nil nil
	lyskom-main-menu nil nil nil))
	
(setq lyskom-review-menu
      '("Återse"
	kom-review-next kom-review-comments
	kom-review-all-marked-texts kom-review-backward
	kom-review-marked-texts kom-review-last-normally-read
	kom-review-by-to kom-review-stack
	kom-review-tree kom-review-stack
	kom-review-noconversion kom-review-clear
	lyskom-main-menu nil nil nil))

(setq lyskom-text-menu
      '("Inlägg"
	kom-add-comment kom-add-copy
	kom-add-recipient kom-jump
	nil nil
	nil nil
	nil nil
	nil nil
	lyskom-main-menu nil nil nil))

(setq lyskom-other-menu
      '("Övrigt"
	kom-add-member kom-add-self
	nil nil
	nil nil
	nil nil
	nil nil
	nil nil
	lyskom-main-menu nil nil nil nil))

(defun lyskom-menu-build-buffer (&optional commands)
  (interactive "XMeny: ")
  (setq lyskom-menu-buffer (get-buffer-create "*LysKOM Commands*")
	lyskom-menu-window-height 0)
  (save-excursion
    (set-buffer lyskom-menu-buffer)
    (erase-buffer)
    (lyskom-menu-mode)
    (setq commands (or commands lyskom-current-menu lyskom-main-menu))
    (setq lyskom-current-menu commands)
    (setq lyskom-menu-mode-line (car commands))
    (let ((coms (cdr commands))
	  (colwidth (1- (/ (frame-width) lyskom-menu-columns)))
	  (col 0)
	  str is-menu is-null)
      (while coms
	(if (setq str (car (cdr (assq (car coms) lyskom-menus))))
	    (setq is-menu t)
	  (setq str (or (car (cdr (assq (car coms) lyskom-menu-commands)))
			(car (cdr (assq (car coms) lyskom-commands)))
			""))
	  (setq is-menu nil))
	(setq is-null (string= str ""))
	(if (> (length str) colwidth)
	    (setq str (concat (substring str 0 colwidth) "+"))
	  (setq str (concat str
			    (make-string (- colwidth (length str)) ? )
			    " ")))
	(if is-null nil
	  (put-text-property 0 colwidth 'mouse-face 'highlight str)
	  (if is-menu
	      (progn
		(put-text-property 0 colwidth 'face 'lyskom-menu-menu-face str)
		(put-text-property 0 colwidth
				   'lyskom-command 'lyskom-menu-select str)
		(put-text-property 0 colwidth 'lyskom-menu (car coms) str))
	    (put-text-property 0 colwidth 'face 'lyskom-menu-command-face str)
	    (put-text-property 0 colwidth 'lyskom-command (car coms) str)))
	(insert str)
	(setq col (mod (1+ col) lyskom-menu-columns))
	(if (zerop col)
	    (progn
	      (insert "\n")
	      (setq lyskom-menu-window-height
		    (min (1+ lyskom-menu-window-height)
			 lyskom-menu-window-max-height))))
	(setq coms (cdr coms))))
    (goto-char (point-min))))

(defun lyskom-menu-resize ()
  "Resize the LysKOM menu window to the appropriate size"
  (if (window-live-p lyskom-menu-window)
      (let ((save-window (selected-window)))
	(select-window lyskom-menu-window)
	(enlarge-window (- lyskom-menu-window-height
			   (window-height) -1))
	(select-window save-window))
    (save-excursion
      (setq lyskom-menu-window
	    (split-window nil (- (window-height)
				 (max 5 lyskom-menu-window-height))))
      (set-window-buffer lyskom-menu-window lyskom-menu-buffer)
      (set-window-dedicated-p lyskom-menu-window t)))
  (setq lyskom-menu-window-width (window-width lyskom-menu-window)))

(defun lyskom-menu-update ()
  "Update the LysKOM menu buffer

Update the LysKOM menu buffer according to possible changes in the
environment."
  (if show-lyskom-menu
      (progn
	(or lyskom-menu-buffer
	     (lyskom-menu-build-buffer))
	(and (window-live-p lyskom-menu-window)
	     (/= (window-width lyskom-menu-window) lyskom-menu-window-width)
	     (lyskom-menu-build-buffer))
	(lyskom-menu-resize))))

(defun lyskom-menu-show ()
  "Display the LysKOM menu buffer."
  (interactive)
  (setq lyskom-menu-window-height 0
	lyskom-menu-window-width 0
	show-lyskom-menu t)
  (lyskom-menu-update))

(defun lyskom-menu-hide ()
  "Hide the LysKOM menu buffer."
  (interactive)
  (setq show-lyskom-menu nil)
  (delete-window lyskom-menu-window))

(defun lyskom-menu-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'lyskom-menu-mode)
  (setq mode-name "LysKOM Commands")
  (setq truncate-lines t)
  (local-set-key [mouse-2] 'lyskom-menu-mouse-command)
  (setq mode-line-buffer-identification
	(append
	 (mapcar '(lambda (str)
		    (if (stringp str)
		        (elib-string-replace-match "%[1-9]*b" str "")
		      str))
		 mode-line-buffer-identification)
	 '("LysKOM meny:  " lyskom-menu-mode-line))))

(defun lyskom-buffer-p (buffer)
  "Is BUFFER a running LysKOM buffer?"
  (save-excursion
    (set-buffer buffer)
    (and (boundp 'lyskom-proc)
	 lyskom-proc
	 (processp lyskom-proc)
	 (memq (process-status lyskom-proc) '(run open))
	 (eq (current-buffer) (process-buffer lyskom-proc)))))

(defun select-closest-lyskom-buffer ()
  "Select the first available LysKOM buffer displayed

If none is available, display it in the largest window"
  (if (let ((w (selected-window)))
	(catch 'done
	  (while t
	    (if (lyskom-buffer-p (window-buffer w))
		(progn
		  (select-window w)
		  (throw 'done w)))
	    (setq w (next-window w 'no 'visible))
	    (if (eq w (selected-window))
		(throw 'done nil)))))
      nil
    ;; No visible session
    (let ((buffers (buffer-list)))
      (while (and buffers
		  (or (eq (car buffers) (current-buffer))
		      (not (lyskom-buffer-p (car buffers)))))
	(setq buffers (cdr buffers)))
      (if buffers
	  (progn
	    (select-window (get-largest-window))
	    (show-buffer (selected-window) (car buffers)))))))
		
(defun lyskom-menu-mouse-command (event)
  (interactive "e")
  (let ((buf (window-buffer (posn-window (event-end event))))
	(pos (make-marker))
	fcn menu)
    (save-excursion
      (set-buffer buf)
      (set-marker pos (posn-point (event-end event))))
    (setq fcn (get-text-property pos 'lyskom-command buf))
    (cond
     ((null fcn) (error "No command."))
     ((eq fcn 'lyskom-menu-select)
      (lyskom-menu-build-buffer
       (symbol-value (get-text-property pos 'lyskom-menu buf))))
     (t (select-closest-lyskom-buffer)
	(call-interactively fcn)))))

(define-key lyskom-mode-map [mouse-2] 'lyskom-menu-mouse-command)
(define-key lyskom-mode-map [mouse-1] 'lyskom-menu-mouse-command)
(add-hook 'lyskom-after-command-hook 'lyskom-menu-update)

;;;

(provide 'lyskom-menu)

;;; lyskom-menu.el ends here