Commit a0f71490 authored by David Byers's avatar David Byers
Browse files

Implemented better keyboard menus for Hans and Marcus.

parent 1d056c0c
2002-06-26 David Byers <>
* keyboard-menu.el: New file.
(lyskom-read-from-menu): Main function.
* (kom-keyboard-menu-immediate-selection): New
* lyskom-buttons.el (lyskom-keyboard-menu): Use
2002-06-23 David Byers <>
Try to fix bug 429 (sort of):
......@@ -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 \
......@@ -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:")
;;;;; -*-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
;;;; ================================================================
;;;; ================================================================
;;;; 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
(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)
(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))))
(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)
(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))
(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
(1+ default-keys-index))))
(unless (member key used-keys)
(setq mnemonic key))))
(setq used-keys (cons mnemonic used-keys))
(list mnemonic string element)))
(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)
(cond ((or (null pos)
(null lyskom-keyboard-menu-selection))
(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
(save-excursion (goto-char pos)
(1+ (point))))
(move-overlay lyskom-keyboard-menu-overlay
(save-excursion (goto-char pos)
(1+ (point)))))
(goto-char pos)
(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))
;; Format the buffer
(set-buffer buffer)
(insert (format "%s\n%s\n"
(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
(list 'lyskom-keyboard-menu-item el)
(goto-char (point-min))
(setq table (cons (cons nil nil) table))
;; Display the window and do the thing
(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)
(make-extent 1 1 lyskom-keyboard-menu-buffer)
(make-overlay 0 0 lyskom-keyboard-menu-buffer)))
(result nil))
(set-extent-face lyskom-keyboard-menu-overlay nil)
(overlay-put lyskom-keyboard-menu-overlay 'face nil))
(condition-case nil
(while (null result)
(let ((c (lyskom-keyboard-menu-read-char
(lyskom-format "%#1s %#2s: %#3s"
(lyskom-get-string 'keyboard-menu-help)
(or (elt lyskom-keyboard-menu-selection 1)
(cond ((eq (lookup-key global-map (vector c)) 'keyboard-quit)
((or (eq c 'up)
(eq c ?\C-p)
(eq c ?\C-b)
(eq c 'left))
((or (eq c 'down)
(eq c ?\C-n)
(eq c ?\C-f)
(eq c 'right))
((or (eq c 'return)
(eq c ?\r)
(eq c ?\n))
(setq result lyskom-keyboard-menu-selection))
((and (characterp c)
(assoc (make-string 1 c)
(if kom-keyboard-menu-immediate-selection
(setq result (assoc (make-string 1 c)
(setq lyskom-keyboard-menu-selection
(assoc (make-string 1 c)
(when lyskom-keyboard-menu-selection
(setq lyskom-keyboard-menu-menu
(lyskom-rotate-list lyskom-keyboard-menu-menu
(quit (setq result nil)))
(elt result 2)
(defun lyskom-keyboard-menu-up ()
(setq lyskom-keyboard-menu-selection (car (last lyskom-keyboard-menu-menu))))
(defun lyskom-keyboard-menu-down ()
(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))))
......@@ -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
(setq prompt (substring title 0
(min (lyskom-string-width title)
(- (window-width (minibuffer-window))
maxlen 3))) ": "))
maxlen 3))))
(let ((choice (lyskom-completing-read prompt
(let ((choice (lyskom-read-from-menu prompt
entries t)
(cons (car (car entries))
0) nil)))
entries t))))
(when choice
(funcall (cdr (lyskom-string-assoc choice entries))
(funcall (cdr choice)
buf arg text)))))
......@@ -83,6 +83,7 @@
......@@ -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
......@@ -1381,8 +1381,6 @@ 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
(no-such-command . "Det finns inget sdant kommando.\n")
(command-completions . "Du kan mena ngon av fljande:\n %#1s\n")
......@@ -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:")
......@@ -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."
(def-kom-var kom-edit-hide-add-button nil
"*If non-nil, hide the add button shown after the headers when editing
a text."
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment