Implemented better keyboard menus for Hans and Marcus.

src/ChangeLog

+2002-06-26  David Byers  <david.byers@swipnet.se>
+
+	* keyboard-menu.el: New file.
+	(lyskom-read-from-menu): Main function.
+
+	* vars.el.in (kom-keyboard-menu-immediate-selection): New
+	variable.
+
+	* lyskom-buttons.el (lyskom-keyboard-menu): Use
+	lyskom-read-from-menu.
+
 2002-06-23  David Byers  <david.byers@swipnet.se>
 
 	Try to fix bug 429 (sort of):

src/Makefile

@@ -73,6 +73,7 @@ SOURCES	 = 	komtypes.el \
 		deferred-insert.el \
 		utilities.el \
 		completing-read.el \
+		keyboard-menu.el \
 		command.el \
 		buffers.el \
 		aux-items.el \

src/english-strings.el

@@ -1368,8 +1368,6 @@ On since %#8s%#9s")
     (doing-nowhere-conn . "but is")
     (waiting-for-membership . "Waiting for the membership list to be fetched...%d/%d")
 
-    (keyboard-menu-help . "Next: SPC  Prev: DEL  Select: RET  Cancel: ESC")
-
     ;; From slow.el
     (no-such-command . "There is no such command.\n")
     (command-completions . "You may mean one of the following:\n %#1s\n")
@@ -1380,7 +1378,6 @@ On since %#8s%#9s")
     (language-set-to . "Language set to %#1s.\n")
     (language-not-loaded . "%#1s is unavailable.\n")
 
-;;    (reformat-generic . "(%#1s)")
     (reformat-html . "HTML")
     (reformat-enriched . "enriched")
     (reformat-filled . "filled")
@@ -1791,6 +1788,9 @@ have been removed, you can fix the problem by giving the command
     (ssh-cant-connect . "Unable to open ssh connection: %s")
     (ssh-closnig . "Closing ssh connection to %#1s")
     (ssh-unknown-host . "unknown host")
+
+    (keyboard-cancel . "Cancel")
+    (keyboard-menu-help . "(choose: C-n, C-p; confirm: RET)")
     ))
 
 
@@ -3584,6 +3584,10 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
     (kom-format-html-authors-doc . "\
   This setting controls which author's HTML messages that the client will
   attempt to format.")
+    (kom-keyboard-menu-immediate-selection-doc . "\
+  This setting controls whether keyboard shortcuts in text-based context
+  menus require confirmation with return or not. With this on you have
+  to confirm all selections with return.")
 
 
     ;;
@@ -3760,6 +3764,7 @@ be saved in the server. Otherwise it will be saved in your .emacs.")
     (kom-async-highlight-text-body-tag . "Color message backgrounds:")
     (kom-edit-hide-add-button-tag . "Show add button when writing texts:")
     (kom-format-html-authors-tag . "Format HTML-messages per author:")
+    (kom-keyboard-menu-immediate-selection-tag . "Shortcuts in text menus require confirmation:")
     )
 )
 

src/keyboard-menu.el

+;;;;; -*-coding: iso-8859-1;-*-
+;;;;;
+;;;;; $Id$
+;;;;; Copyright (C) 1991-2002  Lysator Academic Computer Association.
+;;;;;
+;;;;; This file is part of the LysKOM Emacs LISP client.
+;;;;; 
+;;;;; LysKOM 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.
+;;;;; 
+;;;;; LysKOM 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 LysKOM; see the file COPYING.  If not, write to
+;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
+;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+;;;;; MA 02139, USA.
+;;;;;
+;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
+;;;;;
+;;;; ================================================================
+;;;; ================================================================
+;;;;
+;;;; File: keyboard-menu.el
+;;;;
+;;;; Implements completing-read almost-compatible lyskom-read-from-menu
+;;;; used to implement keyboard navigation of LysKOM menus ('cos tmm
+;;;; was *so* ugly).
+;;;;
+
+
+(setq lyskom-clientversion-long 
+      (concat lyskom-clientversion-long
+	      "$Id$\n"))
+
+(defvar lyskom-keyboard-menu-menu)
+(defvar lyskom-keyboard-menu-buffer)
+(defvar lyskom-keyboard-menu-prompt)
+(defvar lyskom-keyboard-menu-selection)
+(defvar lyskom-keyboard-menu-overlay)
+
+(defun lyskom-keyboard-menu-read-char (prompt)
+  (message prompt)
+  (sit-for 0)
+  (lyskom-xemacs-or-gnu
+   (let ((ev (next-command-event nil prompt)))
+	    (when (eq 'key-press (event-type ev))
+	      (cond ((eq (event-key ev) 'return) 'return)
+		    ((event-to-character ev))
+		    ((event-key ev))
+		    (t nil))))
+   (read-event)))
+
+
+(defun lyskom-keyboard-menu-keys-for-string (string)
+  "Return a list of suitable mnemonics for menu item STRING."
+  (let ((a-uc nil)
+        (a-lc nil)
+        (b-uc nil)
+        (b-lc nil)
+        (c-uc nil)
+        (c-lc nil))
+    (lyskom-traverse word (string-split " " string)
+      (unless (eq (elt word 0) ?\()
+        (setq a-lc (cons (downcase (substring word 0 1)) a-lc)
+              a-uc (cons (upcase (substring word 0 1)) a-uc))
+        (when (> (length word) 1)
+          (setq b-lc (cons (downcase (substring word 1 2)) b-lc)
+                b-uc (cons (upcase (substring word 1 2)) b-uc)))
+        (when (> (length word) 2)
+          c-lc (cons (downcase (substring word 2 3)) c-lc)
+          c-uc (cons (upcase (substring word 2 3)) c-uc))
+        ))
+    (mapcar (lambda (s)
+              (lyskom-xemacs-or-gnu
+               s
+               (encode-coding-string s default-keyboard-coding-system)))
+            (nconc (nreverse a-lc)
+                   (nreverse b-lc)
+                   (nreverse c-lc)
+                   (nreverse a-uc)
+                   (nreverse b-uc)
+                   (nreverse c-uc)
+                   ))))
+
+
+(defun lyskom-keyboard-menu-frob-table (table)
+  "Convert TABLE to a form suitable for keyboard menus.
+TABLE is an alist whose elements' cars are strings. The result will
+be an alist whose elements' cars are mnemonics for the string in the
+same element's cdr."
+  (let ((used-keys nil)
+        (default-keys "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+        (default-keys-index 0))
+    (nconc
+     (mapcar 
+      (lambda (element)
+        (let* ((string (car element))
+               (keys (lyskom-keyboard-menu-keys-for-string string))
+               (mnemonic (lyskom-traverse key keys
+                           (unless (member key used-keys)
+                             (lyskom-traverse-break key)))))
+
+          (while (and (not mnemonic)
+                      (< default-keys-index (length default-keys)))
+            (let ((key (substring default-keys 
+                                  default-keys-index
+                                  (1+ default-keys-index))))
+              (unless (member key used-keys)
+                (setq mnemonic key))))
+
+          (setq used-keys (cons mnemonic used-keys))
+          (list mnemonic string element)))
+      table)
+     (list (list "C-g" (lyskom-get-string 'keyboard-cancel) nil)))))
+
+
+
+(defun lyskom-keyboard-menu-highlight-selected ()
+  (set-buffer lyskom-keyboard-menu-buffer)
+  (let ((pos (text-property-any (point-min) 
+                                (point-max)
+                                'lyskom-keyboard-menu-item
+                                lyskom-keyboard-menu-selection)))
+    (cond ((or (null pos)
+               (null lyskom-keyboard-menu-selection))
+           (lyskom-xemacs-or-gnu
+            (set-extent-face lyskom-keyboard-menu-overlay nil)
+            (overlay-put lyskom-keyboard-menu-overlay 'face nil))
+           (goto-char (point-min)))
+          (t (lyskom-xemacs-or-gnu
+              (set-extent-endpoints lyskom-keyboard-menu-overlay
+                                    pos
+                                    (save-excursion (goto-char pos)
+                                                    (end-of-line)
+                                                    (1+ (point))))
+              (move-overlay lyskom-keyboard-menu-overlay
+                            pos
+                            (save-excursion (goto-char pos)
+                                            (end-of-line)
+                                            (1+ (point)))))
+             (goto-char pos)
+             (lyskom-xemacs-or-gnu
+              (set-extent-face lyskom-keyboard-menu-overlay 'kom-mark-face)
+              (overlay-put lyskom-keyboard-menu-overlay
+                           'face 'kom-mark-face))))))
+
+(defun lyskom-read-from-menu (prompt table)
+  "Let the user select one of the values in TABLE.
+TABLE is an alist whose elements' cars are strings.
+Returns the selected string."
+  (let* ((menu (lyskom-keyboard-menu-frob-table table))
+         (buffer (get-buffer-create "*Keyboard menu*"))
+         (line-length (apply 'max
+                             (mapcar (lambda (x)
+                                       (+ (length (elt x 0))
+                                          (length (elt x 1))
+                                          3))
+                                     menu))))
+    (save-excursion
+
+      ;; Format the buffer
+
+      (set-buffer buffer)
+      (erase-buffer)
+      (insert (format "%s\n%s\n"
+                      prompt
+                      (make-string line-length ?-)))
+      (lyskom-traverse el menu
+        (unless (cdr (memq el menu))
+          (insert (make-string line-length ?-))
+          (insert "\n"))
+        (let ((start (point)))
+          (insert (format "%s (%s)\n" (elt el 1) (elt el 0)))
+          (add-text-properties start
+                               (point)
+                               (list 'lyskom-keyboard-menu-item el)
+                               )))
+      (goto-char (point-min))
+
+      (setq table (cons (cons nil nil) table))
+
+      ;; Display the window and do the thing
+
+      (save-window-excursion
+        (split-window (selected-window) (+ 5 (length table)))
+        (switch-to-buffer buffer)
+        (let* ((lyskom-keyboard-menu-buffer buffer)
+               (lyskom-keyboard-menu-menu menu)
+               (lyskom-keyboard-menu-selection nil)
+               (lyskom-keyboard-menu-overlay 
+                (lyskom-xemacs-or-gnu
+                 (make-extent 1 1 lyskom-keyboard-menu-buffer)
+                 (make-overlay 0 0 lyskom-keyboard-menu-buffer)))
+               (result nil))
+
+          (lyskom-xemacs-or-gnu
+           (set-extent-face lyskom-keyboard-menu-overlay nil)
+           (overlay-put lyskom-keyboard-menu-overlay 'face nil))
+
+          (condition-case nil
+              (while (null result)
+                (lyskom-keyboard-menu-highlight-selected)
+                (let ((c (lyskom-keyboard-menu-read-char 
+                          (lyskom-format "%#1s %#2s: %#3s"
+                                         prompt
+                                         (lyskom-get-string 'keyboard-menu-help)
+                                         (or (elt lyskom-keyboard-menu-selection 1)
+                                             "")))))
+                  (cond ((eq (lookup-key global-map (vector c)) 'keyboard-quit)
+                         (keyboard-quit))
+                        ((or (eq c 'up)
+			     (eq c ?\C-p)
+			     (eq c ?\C-b)
+			     (eq c 'left))
+                         (lyskom-keyboard-menu-up))
+                        ((or (eq c 'down)
+			     (eq c ?\C-n)
+			     (eq c ?\C-f)
+			     (eq c 'right))
+                         (lyskom-keyboard-menu-down))
+                        ((or (eq c 'return)
+			     (eq c ?\r)
+			     (eq c ?\n))
+                         (setq result lyskom-keyboard-menu-selection))
+                        ((and (characterp c)
+                              (assoc (make-string 1 c) 
+				     lyskom-keyboard-menu-menu))
+                         (if kom-keyboard-menu-immediate-selection
+                             (setq result (assoc (make-string 1 c) 
+						 lyskom-keyboard-menu-menu))
+                           (setq lyskom-keyboard-menu-selection
+                                 (assoc (make-string 1 c)
+					lyskom-keyboard-menu-menu))))))
+                (when lyskom-keyboard-menu-selection
+                  (setq lyskom-keyboard-menu-menu
+                        (lyskom-rotate-list lyskom-keyboard-menu-menu
+                                            lyskom-keyboard-menu-selection))))
+            (quit (setq result nil)))
+          (elt result 2)
+      )))))
+
+
+(defun lyskom-keyboard-menu-up ()
+  (interactive)
+  (setq lyskom-keyboard-menu-selection (car (last lyskom-keyboard-menu-menu))))
+
+
+(defun lyskom-keyboard-menu-down ()
+  (interactive)
+  (if lyskom-keyboard-menu-selection
+      (setq lyskom-keyboard-menu-selection (car (cdr lyskom-keyboard-menu-menu)))
+    (setq lyskom-keyboard-menu-selection (car lyskom-keyboard-menu-menu))))

src/lyskom-buttons.el

@@ -256,21 +256,16 @@ If there is no active area, then do something else."
     (lyskom-traverse e entries
       (if (> (lyskom-string-width (car e)) maxlen)
           (setq maxlen (lyskom-string-width (car e)))))
-    (setq prompt (concat 
-                  (substring title 0
-                             (min (lyskom-string-width title)
-                                  (- (window-width (minibuffer-window))
-                                     maxlen 3))) ": "))
-
-    (let ((choice (lyskom-completing-read prompt
-                                          (lyskom-maybe-frob-completion-table
-                                           entries t)
-                                          nil
-                                          t 
-                                          (cons (car (car entries))
-                                                0) nil)))
+    (setq prompt (substring title 0
+			    (min (lyskom-string-width title)
+				 (- (window-width (minibuffer-window))
+				    maxlen 3))))
+
+    (let ((choice (lyskom-read-from-menu prompt
+                                         (lyskom-maybe-frob-completion-table
+                                          entries t))))
       (when choice
-        (funcall (cdr (lyskom-string-assoc choice entries))
+        (funcall (cdr choice)
                  buf arg text)))))
 
        

src/option-edit.el

@@ -83,6 +83,7 @@
     [kom-presence-messages-in-buffer]
     "\n"
     [kom-text-no-prompts]
+    [kom-keyboard-menu-immediate-selection]
     [kom-page-before-command]
     [kom-deferred-printing]
     [kom-max-buffer-size]
@@ -717,6 +718,7 @@ customize buffer but do not save them to the server."
     (kom-print-seconds-in-time-strings (toggle (yes no)))
     (kom-extended-status-information (toggle (yes no)))
     (kom-edit-hide-add-button (noggle (yes no)))
+    (kom-keyboard-menu-immediate-selection (noggle (yes no)))
 ))
 
 (defvar lyskom-widget-functions 

src/swedish-strings.el

@@ -1381,9 +1381,7 @@ Uppkopplad sedan %#8s%#9s")
     (doing-nowhere-conn . "men r")
     (waiting-for-membership . "Vntar p att medlemskapslistan ska lsas in...%d/%d")
 
-    (keyboard-menu-help . "Nsta: SPC  Freg: DEL  Utfr: RET  Avbryt: ESC")
-    
-	   ;; From slow.el
+    ;; From slow.el
     (no-such-command . "Det finns inget sdant kommando.\n")
     (command-completions . "Du kan mena ngon av fljande:\n %#1s\n")
     (which-language . "ndra sprk till: ")
@@ -1392,7 +1390,6 @@ Uppkopplad sedan %#8s%#9s")
     (language-set-to . "Sprket r %#1_s.\n")
     (language-not-loaded . "%#1s finns inte tillgngligt.\n")
 
-;;    (reformat-generic . "(%#1s)")
     (reformat-html . "HTML")
     (reformat-enriched . "enriched")
     (reformat-filled . "ombruten")
@@ -1803,6 +1800,9 @@ kommandot \"Spara variabler\".\n\n")
     (ssh-cant-connect . "Kan inte gra ssh-uppkopplingen: %s")
     (ssh-closnig . "Stnger ssh-uppkopplingen till %#1s")
     (ssh-unknown-host . "oknd vrd")
+
+    (keyboard-cancel . "Avbryt")
+    (keyboard-menu-help . "(vlj: C-n, C-p; bekrfta: RET)")
     ))
 
 (lyskom-language-var local lyskom-month-names sv
@@ -3644,6 +3644,10 @@ i servern. Annars sparas det i din .emacs.")
     (kom-format-html-authors-doc . "\
   Den hr instllningen styr vilka frfattares HTML-meddelanden som
   elispklienten kommer att frska formattera.")
+    (kom-keyboard-menu-immediate-selection-doc . "\
+  Den hr instllningen styr huruvida snabbtangenter automatiskt bekrftar
+  val i textbaserade menyer eller inte. Om detta r pslaget s mste man
+  alltid trycka retur fr att vlja i textbaserade menyer.")
 
 
     ;;
@@ -3820,6 +3824,7 @@ i servern. Annars sparas det i din .emacs.")
     (kom-async-highlight-text-body-tag . "Annorlunda bakgrundsfrg p meddelanden:")
     (kom-edit-hide-add-button-tag . "Visa Addera-knappen nr man skriver inlgg:")
     (kom-format-html-authors-tag . "Formattera HTML-meddelanden per frfattare:")
+    (kom-keyboard-menu-immediate-selection-tag . "Snabbval i textmenyer krver bekrftelse:")
     )
 )
 

src/vars.el.in

@@ -122,6 +122,12 @@ if the variable is in kom-dont-read-saved-variables."
 
 ;;; User flags
 
+(def-kom-var kom-keyboard-menu-immediate-selection nil
+  "*When non-nil, typing a keyboard shortcut in a keyboard menu selects
+the item immediately, without requiring the user to press RET to confirm."
+  server)
+
+
 (def-kom-var kom-edit-hide-add-button nil
   "*If non-nil, hide the add button shown after the headers when editing
 a text."