(defface xcompose-angle-face
'((t (:inherit bold)))
"Face for the angle brackets (<>) around key-names."
:group 'xcompose-mode)
(defface xcompose-keys-face
'((t (:inherit font-lock-constant-face)))
"Face for the key names."
:group 'xcompose-mode)
(defface xcompose-string-face
'((t (:inherit font-lock-string-face
:height 1.2
:box "black")))
"Face for the quoted strings containing the character(s) to be produced."
:group 'xcompose-mode)
(defface xcompose-quotemark-face
'((t (:inherit font-lock-string-face
:foreground "dark orchid")))
"Face for quote-marks around character strings."
:group 'xcompose-mode)
(defface xcompose-num-face
'((t (:inherit font-lock-preprocessor-face :weight bold)))
"Face for the hex numbers identifying the code-point."
:group 'xcompose-mode)
(defface xcompose-U-face
'((t (:inherit font-lock-preprocessor-face)))
"Face for the U before the hex numbers."
:group 'xcompose-mode)
(defface xcompose-colon-face
'((t (:inherit bold)))
"Face for the \":\" separating the keystrokes from the character string."
:group 'xcompose-mode)
(defface xcompose-comment-face
`((t (:inherit font-lock-comment-face
:foreground "light coral")))
"Face for comments in xcompose files."
:group 'xcompose-mode)
(defvar xcompose-mode-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?< "(> " st)
(modify-syntax-entry ?> ")< " st)
(modify-syntax-entry ?# "< " st)
(modify-syntax-entry ?_ "_ " st)
(modify-syntax-entry ?\n "> " st)
(modify-syntax-entry ?{ "| " st)
(modify-syntax-entry ?} "| " st)
st)
"Syntax table for xcompose-mode")
(defvar xcompose-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c u") 'xcompose-fill-in-char-string)
(define-key map (kbd "C-c C-u") 'xcompose-fill-in-char-code)
(define-key map (kbd "C-c ;") 'xcompose-insert-char-name)
map)
"Keymap for xcompose-mode")
(defvar xcompose-font-lock-keywords
'(
("[<>]" . 'xcompose-angle-face)
("<\\([a-zA-Z0-9_]*\\)>" . (1 'xcompose-keys-face))
("\"\\([^\"]*\\)\"" . (1 'xcompose-string-face))
("\"" . 'xcompose-quotemark-face)
("\\(U\\)\\([0-9A-Fa-f]*\\)" .
((1 'xcompose-U-face) (2 'xcompose-num-face)))
(":" . 'xcompose-colon-face)
("^.*{[^}]\\{8,\\}}.*$" 0 'xcompose-comment-face prepend)
)
"Keywords for xcompose-mode")
(defvar xcompose-key-re "<[a-zA-Z0-9_]+"
"Regexp matching the beginning of a keystroke.")
(define-abbrev-table 'xcompose-mode-abbrev-table
'(("<Mu" "<Multi_key>" nil :system t)
("<ap" "<apostrophe>" nil :system t)
("<am" "<ampersand>" nil :system t)
("<asciic" "<asciicircum>" nil :system t)
("<asciit" "<asciitilde>" nil :system t)
("<ast" "<asterisk>" nil :system t)
("<bac" "<backslash>" nil :system t)
("<bar" "<bar>" nil :system t)
("<bracel" "<braceleft>" nil :system t)
("<bracer" "<braceright>" nil :system t)
("<bracketl" "<brakcetleft>" nil :system t)
("<bracketr" "<brakcetright>" nil :system t)
("<col" "<colon>" nil :system t)
("<com" "<comma>" nil :system t)
("<do" "<dollar>" nil :system t)
("<gra" "<grave>" nil :system t)
("<gre" "<greater>" nil :system t)
("<le" "<less>" nil :system t)
("<mi" "<minus>" nil :system t)
("<nu" "<numbersign>" nil :system t)
("<parenl" "<parenleft>" nil :system t)
("<parenr" "<parenright>" nil :system t)
("<perc" "<percent>" nil :system t)
("<peri" "<period>" nil :system t)
("<pl" "<plus>" nil :system t)
("<quo" "<quotedbl>" nil :system t)
("<se" "<semicolon>" nil :system t)
("<sp" "<space>" nil :system t)
("<un" "<underscore>" nil :system t)
)
"Abbrev table"
:regexp "\\(<[a-zA-Z0-9_]+\\)"
:case-fixed t)
(defun xcompose-expand-abbrev ()
"Run `expand-abbrev' when text before point matches `xcompose-key-re'"
(when (looking-back xcompose-key-re (line-beginning-position))
(expand-abbrev)))
(defun xcompose-capitalize-comment nil
"Set any trailing comment on the current line to all-caps."
(interactive)
(save-excursion
(let* ((eol (progn (end-of-line) (point)))
(bol (progn (beginning-of-line) (point))))
(if (search-forward comment-start eol t)
(upcase-region (point) eol)))))
(defun xcompose-find-quoted-char (&optional pos)
"Find the character in quotes in the current line (or that given by pos)."
(save-excursion
(let* ((pos (or pos (point)))
(chr nil)
(eol (progn (end-of-line) (point)))
(bol (progn (beginning-of-line) (point))))
(if (search-forward ":" eol t)
(progn
(if (search-forward "\"" eol t)
(setq chr (char-after)))))
chr)))
(defun xcompose-fill-in-char-code (&optional pos)
"Look up character in string on line given and fill in the UXXXX code at point."
(interactive)
(let* ((pos (or pos (point)))
(chr (xcompose-find-quoted-char pos)))
(goto-char pos)
(insert (format "U%.04X" chr))))
(defun xcompose-fill-in-char-string (&optional pos)
"Look up character given by UXXXX code on line given and insert into string before it, separated by a space."
(interactive)
(let* ((pos (or pos (point)))
(eol (progn (end-of-line) (point)))
(bol (progn (beginning-of-line) (point))))
(if (search-forward-regexp "\\<U\\([[:xdigit:]]+\\)" eol)
(let* ((hex (match-string 1))
(num (string-to-number hex 16))
(str (char-to-string num)))
(goto-char (match-beginning 0))
(insert (format "\"%s\" " str))))))
(defun xcompose-insert-char-name nil
"Find the (first) quoted character on the line, and insert its name as
a comment at the end of the line."
(interactive)
(let* ((pos (point))
(chr (xcompose-find-quoted-char pos)))
(goto-char pos)
(move-to-column (max (+ 4 (current-column)) comment-column) t)
(insert (format "# %s" (get-char-code-property chr 'name)))))
(define-derived-mode xcompose-mode fundamental-mode "XCompose"
"Major mode for .XCompose files
\\{xcompose-mode-map}"
(font-lock-add-keywords nil xcompose-font-lock-keywords)
(setq-local comment-end "\n")
(setq-local comment-continue " *")
(setq-local comment-start-skip "/[*/]+[ \t]*")
(setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)")
(setq-local font-lock-comment-face 'xcompose-comment-face)
(add-hook 'post-self-insert-hook #'xcompose-expand-abbrev nil t)
(auto-fill-mode 0)
)