GTK does this, and I think it’s a reasonable binding. It is a shame that
there’s no easy way to do it on the TTY.
diff -r 8139bdf8db04 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Aug 03 20:25:03 2014 +0100
+++ b/lisp/ChangeLog Tue Aug 05 00:17:51 2014 +0100
@@ -1,3 +1,17 @@
+2014-08-05 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * keymap.el:
+ * keymap.el (event-apply-modifiers):
+ When a character keysym has case information, apply the shift
+ modifier to it by upcasing it.
+ * keymap.el (synthesize-keysym):
+ Document this a little.
+ * keymap.el (synthesize-unicode-codepoint): New.
+ Like #'synthesize-keysym, but synthesizing a Unicode codepoint.
+ * keymap.el (function-key-map-parent): Bind control shift u to
+ synthesize a Unicode character input, as does GTK+ and as
+ specified by ISO 14755.
+
2014-07-14 Aidan Kehoe <kehoea(a)parhasard.net>
* simple.el (raw-append-message):
diff -r 8139bdf8db04 lisp/keymap.el
--- a/lisp/keymap.el Sun Aug 03 20:25:03 2014 +0100
+++ b/lisp/keymap.el Tue Aug 05 00:17:51 2014 +0100
@@ -445,7 +445,7 @@
"Return the next key event, with a list of modifiers applied.
LIST describes the names of these modifier, a list of symbols.
`function-key-map' is scanned for prefix bindings."
- (let (events binding)
+ (let (events binding key-sequence-list-description symbol-name)
;; read keystrokes scanning `function-key-map'
(while (keymapp
(setq binding
@@ -465,11 +465,21 @@
(mapcar 'character-to-event (cdr events))))
(setq unread-command-events (cdr events)))
;; add modifiers LIST to the first keystroke or event
+ (setf key-sequence-list-description
+ (aref (key-sequence-list-description (car events)) 0))
+ (if (and (member 'shift list)
+ (symbolp (car (last key-sequence-list-description)))
+ (eql 1 (length
+ (setq symbol-name
+ (symbol-name
+ (car (last key-sequence-list-description))))))
+ (not (eql (aref symbol-name 0) (upcase (aref symbol-name 0)))))
+ (setf (car (last key-sequence-list-description))
+ (intern (upcase symbol-name))
+ list (remove* 'shift list)))
(vector
(append list
- (set-difference (aref (key-sequence-list-description (car events))
- 0)
- list :stable t)))))
+ (set-difference key-sequence-list-description list :stable t)))))
(defun event-apply-modifier (symbol)
"Return the next key event, with a single modifier applied.
@@ -480,6 +490,10 @@
"Read a sequence of characters, and return the corresponding keysym.
The characters must be ?-, or ?_, or have word syntax. Reading is
terminated by RET (which is discarded)."
+ ;; This has the disadvantage that only X11 keysyms (and space, backspace
+ ;; and friends, together with the trivial one-character keysyms) are
+ ;; recognised, and then only on a build with X11 support which has had an
+ ;; X11 frame open at some point.
(let ((continuep t)
event char list)
(while continuep
@@ -501,6 +515,32 @@
(error "Event has no character equivalent: %s" event))))
(vector (intern (concat "" (nreverse list))))))
+(defun synthesize-unicode-codepoint (ignore-prompt)
+ "Read a sequence of hexadecimal digits and return a one-char keyboard macro.
+
+The character has the Unicode code point corresponding to those hexadecimal
+digits."
+ (symbol-macrolet ((first-prompt "Unicode hex input: u"))
+ (let* ((prompt first-prompt) (integer 0)
+ (extent (make-extent (1- (length first-prompt))
+ (length first-prompt) prompt))
+ character digit-char-p)
+ (setf (extent-face extent) 'underline
+ (extent-property extent 'duplicable) t)
+ (while (not (member (setq character
+ ;; Discard non-enter non-hex-digit characters,
+ ;; as GTK does.
+ (read-char-exclusive prompt))
+ '(?\r ?\n)))
+ (when (setq digit-char-p (digit-char-p character 16))
+ (setq integer (logior (lsh integer 4) digit-char-p)
+ prompt (concat prompt (list character)))
+ (if (>= integer #x110000)
+ (error 'args-out-of-range "Not a Unicode code point"
integer))
+ (set-extent-endpoints extent (1- (length first-prompt))
+ (length prompt) prompt)))
+ (vector (list (decode-char 'ucs integer))))))
+
(define-key function-key-map-parent [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
(define-key function-key-map-parent [?\C-x ?@ ?s] 'event-apply-super-modifier)
(define-key function-key-map-parent [?\C-x ?@ ?m] 'event-apply-meta-modifier)
@@ -508,6 +548,7 @@
(define-key function-key-map-parent [?\C-x ?@ ?c] 'event-apply-control-modifier)
(define-key function-key-map-parent [?\C-x ?@ ?a] 'event-apply-alt-modifier)
(define-key function-key-map-parent [?\C-x ?@ ?k] 'synthesize-keysym)
+(define-key function-key-map-parent [(control U)] 'synthesize-unicode-codepoint)
;; The autoloads for the compose map, and their bindings in
;; function-key-map-parent are used by GTK as well as X11. And Julian
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches