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

Keyboard shortcuts using swedish chars in menus. Make language selection...

Keyboard shortcuts using swedish chars in menus. Make language selection options clearer in the menus.

Detailed changes:
> 2004-01-01  David Byers  <byers@lysator.liu.se>
>
> 	* menus.el (lyskom-define-menu-xemacs): Try to use swedish
> 	characters rather than brackets and braces for bindings that have
> 	both.
> 	(lyskom-define-menu-gnu): Same here.
>
> 	* utilities.el (lyskom-traverse-keymap): New function.
>
> 	* compatibility.el (map-keymap): More fixes.
>
> 	* menus.el (lyskom-menu-guess-shortcuts): New function.
>
> 	* vars.el.in (lyskom-swedish-bindings): New variable.
> 	(lyskom-swedish-bindings-reverse): Ditto.
>
> 2003-12-18  David Byers  <byers@lysator.liu.se>
>
> 	* compatibility.el (map-keymap): I think this function will work
> 	in Gnu Emacs now.
>
> 	Make language selection more available:
> 	* swedish-strings.el (lyskom-menus): Language-related texts in
> 	swedish and english.
> 	(lyskom-message): Ditto.
>
> 	* menus.el (lyskom-menu-template): Added change local and global
> 	language.
>
> 	* commands2.el (kom-change-global-language): New command.
> 	(kom-change-local-language): New command.
>
> 	Commands at when-done in current language:
> 	* language.el (lyskom-try-get-string): Added language parameter.
> 	(lyskom-get-string): Added language parameter.
>
> 	* command.el (lyskom-command-name): Added language parameter.
>
parent acd4415d
2004-01-01 David Byers <byers@lysator.liu.se>
* menus.el (lyskom-define-menu-xemacs): Try to use swedish
characters rather than brackets and braces for bindings that have
both.
(lyskom-define-menu-gnu): Same here.
* utilities.el (lyskom-traverse-keymap): New function.
* compatibility.el (map-keymap): More fixes.
* menus.el (lyskom-menu-guess-shortcuts): New function.
* vars.el.in (lyskom-swedish-bindings): New variable.
(lyskom-swedish-bindings-reverse): Ditto.
2003-12-18 David Byers <byers@lysator.liu.se>
* compatibility.el (map-keymap): I think this function will work
in Gnu Emacs now.
Make language selection more available:
* swedish-strings.el (lyskom-menus): Language-related texts in
swedish and english.
(lyskom-message): Ditto.
* menus.el (lyskom-menu-template): Added change local and global
language.
* commands2.el (kom-change-global-language): New command.
(kom-change-local-language): New command.
Commands at when-done in current language:
* language.el (lyskom-try-get-string): Added language parameter.
(lyskom-get-string): Added language parameter.
* command.el (lyskom-command-name): Added language parameter.
2003-12-17 David Byers <byers@lysator.liu.se>
Update menus:
......
......@@ -176,10 +176,10 @@
;;;; User-level commands and functions.
(defsubst lyskom-command-name (command)
(defsubst lyskom-command-name (command &optional language)
"Get the command name for the command COMMAND"
(condition-case nil
(lyskom-get-string command 'lyskom-command)
(lyskom-get-string command 'lyskom-command language)
(error nil)))
(defun lyskom-ok-command (alternative administrator)
......
......@@ -2174,6 +2174,16 @@ the exception of the letterbox flag (which cannot be modified)."
;;; ndra sprk
;;;
(defun kom-change-global-language ()
"Use kom-change-language instead."
(interactive)
(kom-change-language t))
(defun kom-change-local-language ()
"Use kom-change-language instead"
(interactive)
(kom-change-language))
(def-kom-command kom-change-language (&optional global)
"Change the current language in the current LysKOM session.
With a prefix argument, also make changes that would affect all
......
......@@ -150,15 +150,21 @@ KEYS should be a string in the format used for saving keyboard macros
(lyskom-function-alias map-keymap (fn keymap &optional sort-first)
(let ((r 0))
(cond ((vectorp keymap)
(while (< r (length keymap))
(if (aref keymap r)
(funcall fn r (aref keymap r)))
(setq r (1+ r))))
(t (mapcar (function
(lambda (x)
(funcall fn (car x) (cdr x))))
(cdr keymap))))))
(when (keymapp keymap)
(when (symbolp keymap) (setq keymap (symbol-value keymap)))
(let ((keymap (cdr keymap))
(el nil))
(while (and keymap (not (keymapp keymap)))
(setq el (car keymap)
keymap (cdr keymap))
(cond ((vectorp keymap)
(while (< r (length el))
(if (aref el r)
(funcall fn r (aref el r)))
(setq r (1+ r))))
((char-table-p el)
(map-char-table fn el))
(t (funcall fn (car el) (cdr el)))))))))
;; set-keymap-parent also comes from XEmacs
......
......@@ -2422,6 +2422,9 @@ Change privileges for %#1P (%#1p)...")
(zu . "Zulu")
(-- . "Unknown language (%#1s)")))
(lyskom-language-missing-string lyskom-menu kom-help en)
(lyskom-language-missing-string lyskom-menu kom-change-language en)
(lyskom-language-strings global lyskom-menu en
'((lyskom . "LysKOM")
(read . "Read")
......@@ -2447,7 +2450,9 @@ Change privileges for %#1P (%#1p)...")
(pers-admin . "User admin")
(autoreply . "Auto-reply")
(remote-control . "Remote control")
(language . "Change language")
(kom-change-global-language . "Display and commands")
(kom-change-local-language . "Display language only")
(kom-edit-send . "Send")
(kom-edit-send-anonymous . "Send anonymously")
(kom-edit-quit . "Throw away")
......
......@@ -207,19 +207,19 @@ assoc list."
(lyskom-internal-error (message "Bad kom-tell-phrases: missing %s" key)
"")))
(defsubst lyskom-try-get-string (symbol category)
(defsubst lyskom-try-get-string (symbol category &optional language)
(cdr (assq (if (eq (cdr (assq category lyskom-language-categories)) 'local)
lyskom-language
lyskom-global-language)
(or language lyskom-language)
(or language lyskom-global-language))
(get symbol category))))
(defsubst lyskom-get-string-error (function symbol category)
(signal 'lyskom-internal-error
(list function (list symbol category ": string not found"))))
(defun lyskom-get-string (symbol &optional category)
(defun lyskom-get-string (symbol &optional category language)
"Returns string associated with SYMBOL"
(or (lyskom-try-get-string symbol (or category 'lyskom-message))
(or (lyskom-try-get-string symbol (or category 'lyskom-message) language)
(lyskom-get-string-error 'lyskom-get-string
symbol
(or category 'lyskom-message))))
......
......@@ -3080,9 +3080,9 @@ Set lyskom-current-prompt accordingly. Tell server what I am doing."
(setq prompt
(let ((command (lyskom-what-to-do-when-done t)))
(cond
((lyskom-command-name command))
((lyskom-command-name command lyskom-language))
((and (stringp command)
(lyskom-command-name (key-binding command))))
(lyskom-command-name (key-binding command) lyskom-language)))
(t (lyskom-format 'the-command command))))))
((eq to-do 'unknown) ;Pending replies from server.
......
......@@ -236,7 +236,8 @@
(item kom-change-message-flag)
(item kom-prioritize)))
(menu pers-admin
((item kom-change-name)
((item kom-change-presentation)
(item kom-change-name)
(item kom-change-parenthesis)
(item kom-change-password)
(item kom-redirect-comments)
......@@ -269,11 +270,13 @@
(menu other
((item kom-help)
(menu language
((item kom-change-global-language)
(item kom-change-local-language)))
(item kom-where-is)
(item kom-display-time)
(item kom-calculate)
(hline)
(item kom-change-language)
(item kom-customize)
(item kom-copy-options)
(item kom-save-options)
......@@ -339,6 +342,31 @@
(defvar lyskom-popup-menu nil
"A keymap the LysKOM menu in the edit buffer.")
(defun lyskom-menu-guess-shortcuts (keymap &optional prefix result force)
(lyskom-traverse-keymap
(lambda (key binding)
(when binding
(let ((force (or force (assq key lyskom-swedish-bindings-reverse))))
(if (keymapp binding)
(setq result
(lyskom-menu-guess-shortcuts
(cond ((symbolp binding) (symbol-value binding))
(t binding))
(append prefix (list key))
result
force))
(when force
(setq key `(,@prefix ,key))
(if (assq binding result)
(setcdr (assq binding result)
(cons (apply 'vector key)
(cdr (assq binding result))))
(setq result (cons (cons binding
(list (apply 'vector key)))
result))))))))
keymap)
result)
(defun lyskom-build-menus ()
"Create menus according to LYSKOM-MENUS"
(lyskom-xemacs-or-gnu (lyskom-build-menus-xemacs)
......@@ -363,58 +391,95 @@
(list lyskom-popup-menu-template))
(setq lyskom-popup-menu (lookup-key lyskom-popup-menu [lyskom])))
(defun lyskom-define-menu-xemacs (menus)
(let ((type nil)
(parameters nil))
(lyskom-ignore type parameters) ; Are they ever used?
(defun lyskom-define-menu-xemacs (menus &optional specials)
(let ((specials (or specials
(lyskom-menu-guess-shortcuts (current-local-map)))))
(cond ((null (car menus)))
((listp (car menus)) ; Menu bar
(mapcar 'lyskom-define-menu-xemacs
menus))
(mapcar (lambda (x) (lyskom-define-menu-xemacs x specials)) menus))
((eq (car menus) 'menu) ; A menu
(let ((menu-title (car (cdr menus)))
(menu-items (car (cdr (cdr menus)))))
(cons (lyskom-get-menu-string menu-title)
(mapcar
(function
(lambda (item)
(cond ((eq (car item) 'item)
(vector (lyskom-get-menu-string
(car (cdr item)))
(car (cdr item))
':active
t))
((eq (car item) 'hline)
"--:shadowEtchedIn")
((eq (car item) 'menu)
(lyskom-define-menu-xemacs item))
(t
(error "Bad menu item: %S"
item)))))
menu-items))))
(lambda (item)
(let ((type (car item))
(symbol (car (cdr item))))
(cond ((eq type 'item)
(let ((shortcut nil))
(when (assq symbol specials)
(unless (lyskom-traverse key (cdr (assq symbol specials))
(unless (condition-case nil
(eq (lookup-key (current-local-map)
key) symbol)
(error nil))
(lyskom-traverse-break t)))
(setq shortcut
(mapconcat
(lambda (key)
(if (assq key lyskom-swedish-bindings-reverse)
(symbol-name
(cdr (assq key lyskom-swedish-bindings-reverse)))
(single-key-description key)))
(car (cdr (assq symbol specials)))
" "))))
(if shortcut
(vector (lyskom-get-menu-string symbol)
symbol
':active t
':keys shortcut)
(vector (lyskom-get-menu-string symbol) symbol ':active t))))
((eq type 'hline)
"--:shadowEtchedIn")
((eq type 'menu)
(lyskom-define-menu-xemacs item specials))
(t (error "Bad menu item: %S" item)))))
menu-items))))
(t nil))))
(defun lyskom-define-menu-gnu (map menus)
(when menus
(lyskom-define-menu-gnu map (cdr menus))
(let ((type (car (car menus)))
(symbol (car (cdr (car menus)))))
(cond ((eq 'hline type)
(define-key map (vector (lyskom-gensym)) '("--")))
((eq 'menu type)
(let* ((name (lyskom-get-menu-string symbol))
(submap (make-sparse-keymap name)))
(define-key map (vector symbol)
(cons name submap))
(lyskom-define-menu-gnu submap
(car (cdr (cdr (car menus)))))))
((eq 'item type)
(define-key map (vector symbol)
(cons (lyskom-get-menu-string symbol) symbol)))
(t (error "Menu description invalid in lyskom-define-menu"))))))
(defun lyskom-define-menu-gnu (map menus &optional specials)
(let ((specials (or specials
(lyskom-menu-guess-shortcuts (current-local-map)))))
(when menus
(lyskom-define-menu-gnu map (cdr menus) specials)
(let ((type (car (car menus)))
(symbol (car (cdr (car menus)))))
(cond ((eq 'hline type)
(define-key map (vector (lyskom-gensym)) '("--")))
((eq 'menu type)
(let* ((name (lyskom-get-menu-string symbol))
(submap (make-sparse-keymap name)))
(define-key map (vector symbol)
(cons name submap))
(lyskom-define-menu-gnu submap
(car (cdr (cdr (car menus))))
specials)))
((eq 'item type)
(let ((shortcut nil))
(when (assq symbol specials)
(unless (lyskom-traverse key (cdr (assq symbol specials))
(unless (condition-case nil
(eq (lookup-key (current-local-map)
key) symbol)
(error nil))
(lyskom-traverse-break t)))
(setq shortcut
(mapconcat
(lambda (key)
(if (assq key lyskom-swedish-bindings-reverse)
(symbol-name
(cdr (assq key lyskom-swedish-bindings-reverse)))
(single-key-description key)))
(car (cdr (assq symbol specials)))
" "))))
(if shortcut
(define-key map (vector symbol)
`(menu-item ,(lyskom-get-menu-string symbol) symbol
:keys ,shortcut))
(define-key map (vector symbol)
(cons (lyskom-get-menu-string symbol) symbol)))))
(t (error "Menu description invalid in lyskom-define-menu")))))))
(defun lyskom-get-menu-category (menu-category)
......@@ -424,9 +489,8 @@
(lyskom-build-menus)
(when (and (boundp 'lyskom-current-menu-category)
lyskom-current-menu-category)
(mapcar (function
(lambda (mc)
(lyskom-set-menus mc (current-local-map))))
(mapcar (lambda (mc)
(lyskom-set-menus mc (current-local-map)))
lyskom-current-menu-category)))
(defun lyskom-set-menus (menu-category keymap)
......
......@@ -1473,7 +1473,7 @@ Uppkopplad sedan %#8s%#9s")
;; 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: ")
(which-language . "ndra sprk till (change language to): ")
(send-formatted . "Skicka in som formatterad text? ")
(changing-language-to . "Byter till %#1_s.\n")
(language-set-to . "Sprket r %#1_s%#2?b%[ %#3@[%#2s]%]%[%].\n")
......@@ -2451,6 +2451,11 @@ Nuvarande r
(-- . "Oknt sprk (%#1s)")))
(lyskom-language-ending-mismatch lyskom-menu language sv en)
(lyskom-language-ending-mismatch lyskom-menu kom-change-language sv en)
(lyskom-language-ending-mismatch lyskom-menu kom-change-global-language sv en)
(lyskom-language-ending-mismatch lyskom-menu kom-change-local-language sv en)
(lyskom-language-strings global lyskom-menu sv
'((lyskom . "LysKOM")
(read . "Ls")
......@@ -2476,6 +2481,11 @@ Nuvarande r
(pers-admin . "Personadministration")
(autoreply . "Automatsvar")
(remote-control . "Fjrrstyrning")
(language . "ndra sprk (Change Language)")
(kom-help . "Hjlp (Help)")
(kom-change-language . "ndra sprk (Change language)")
(kom-change-global-language . "Visning och kommandon (display and commands)")
(kom-change-local-language . "Endast visning (display language only)")
(kom-edit-send . "Skicka in")
(kom-edit-send-anonymous . "Skicka anonymt")
(kom-edit-quit . "Kasta bort")
......@@ -2666,7 +2676,6 @@ Nuvarande r
(define-key lyskom-sv-list-prefix (kbd "f") 'kom-list-filters)
(define-key lyskom-sv-list-prefix (kbd "q") 'kom-list-faqs)
(define-key lyskom-sv-list-prefix (kbd "Q") 'kom-list-server-faqs)
(lyskom-try-define-key lyskom-sv-list-prefix (kbd "") 'kom-list-summary)
(lyskom-try-define-key lyskom-sv-list-prefix (kbd "{") 'kom-list-summary)
......@@ -2690,6 +2699,7 @@ Nuvarande r
(define-key lyskom-sv-filter-get-prefix (kbd "i") 'kom-filter-text)
(define-key lyskom-sv-filter-get-prefix (kbd "m") 'kom-filter-recipient)
(define-key lyskom-sv-filter-get-prefix (kbd "l") 'kom-previous-kom)
(lyskom-try-define-key lyskom-sv-filter-get-prefix (kbd "") 'kom-filter-subject)
(lyskom-try-define-key lyskom-sv-filter-get-prefix (kbd "{") 'kom-filter-subject)
(lyskom-try-define-key lyskom-sv-filter-get-prefix (kbd "[") 'kom-filter-subject)
......@@ -2793,6 +2803,7 @@ Nuvarande r
(define-key lyskom-sv-S-prefix (kbd "u q") 'kom-del-faq)
(define-key lyskom-sv-S-prefix (kbd "u f") 'kom-sub-footnote)
(define-key lyskom-sv-S-prefix (kbd "t") 'kom-save-text)
(lyskom-try-define-key lyskom-sv-S-prefix (kbd "") 'kom-send-message)
(lyskom-try-define-key lyskom-sv-S-prefix (kbd "{") 'kom-send-message)
(lyskom-try-define-key lyskom-sv-S-prefix (kbd "[") 'kom-send-message)
......
......@@ -1100,6 +1100,12 @@ TIME defaults to the current client time."
((and binding
(null base-binding)) (define-key keymap keys binding)))))
(defun lyskom-traverse-keymap (fn keymap)
"Like lyskom-map-keymap, but traverses parent links too."
(let ((parent (keymap-parent keymap)))
(lyskom-map-keymap fn keymap)
(when (keymapp parent) (lyskom-traverse-keymap fn parent))))
;;;
;;; Stuff
......
......@@ -2153,9 +2153,9 @@ conference and person buttons are not expected.")
("\\(file://\\|ftp://\\|gopher://\\|http://\\|https://\\|news:\\|wais://\\|mailto:\\|telnet:\\)[^\t \012\014\"<>|\\]*[^][\t \012\014\"<>|.,!(){}?'`:;]"
url 0 nil kom-url-face)
("<URL:\\s-*\\([^>]*\\)\\s-*>"
("<URL:\\s-*\\([^>]+\\)\\s-*>"
pseudo-url 1 1 kom-url-face lyskom-is-url)
("<\\s-*\\([^>]*\\)\\s-*>"
("<\\s-*\\([^>]+\\)\\s-*>"
pseudo-url 1 1 kom-url-face lyskom-is-url)
;; JySKom enhancements
......@@ -4405,6 +4405,28 @@ the order of this list.")
REVIEW-MARK REVIEW-FAQ
REVIEW-FAQ-TREE))
;;; ============================================================
(defvar lyskom-swedish-bindings
`((å . (aring Aring ,(elt (kbd "å") 0) ,(elt (kbd "Å") 0)
å Å 229 197 2277 2245 3909 3941))
(ä . (adiaeresis Adiaeresis ,(elt (kbd "ä") 0) ,(elt (kbd "Ä") 0)
ä Ä 228 196 2276 2244 3908 3940)))
"Hack to deal with binding swedish characters")
(defvar lyskom-swedish-bindings-reverse
(let ((tmp nil)
(seq lyskom-swedish-bindings))
(while seq
(let ((el (car seq)))
(setq tmp (nconc tmp (mapcar (lambda (x)
(cons x (car el)))
(cdr el)))))
(setq seq (cdr seq)))
tmp)
"Hack to deal with binding swedish characters")
(eval-and-compile (provide 'lyskom-vars))
;;; vars.el ends here
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