aboutsummaryrefslogtreecommitdiff
path: root/xcompose-mode.el
blob: 4140bcb5d9de36dcec290210e78d8b73d775e8eb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
;;; xcompose.el --- major mode for editing .XCompose files
;; Copyright (C) 2019 Mark Shoulson
 
;; Author: Mark Shoulson
;; Maintainer: Mark Shoulson
;; URL:
 
;; This file is NOT part of GNU Emacs
 
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
 
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
 
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
 
;;; Commentary:
 
;; This file provides the major mode xcompose-mode, for use in editing
;; .XCompose files, which are used in X-windows systems to define the
;; behavior certain sequential keystroke combinations, usually involving
;; the "Multi-Key".  It was also built with an eye towards use with "base"
;; files, which are slightly simplified compose files I use for
;; convenience.
 
;; Mainly fontifying; eventually should do better formatting, finding the
;; right tab stops etc.
 
;;; Code:
 
(defface xcompose-angle-face
  ;; Black seems to stand out best, what can I say?
  '((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
  ;; I feel like these should really stand out, not just plain-jane
  ;; font-lock-string-face.  Even to the point of increasing the size and
  ;; drawing boxes.
  '((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)
 
;; Yes, kind of a lot of faces and a lot of fine-tuning of the line's
;; appearance.  Maybe a bit too much.
(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)
 
;; There are LOTS of comments (commented-out lines) in some of these files;
;; I'd like them to fade into the background a bit, and I use a white
;; background.
(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 C-i") 'xcompose-insert-char-name)
    (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))
    ;; ("\"[^\"]*\"" . 'xcompose-string-face)
    ("\"\\([^\"]*\\)\"" . (1 'xcompose-string-face))
    ("\"" . 'xcompose-quotemark-face)
    ("\\(U\\)\\([0-9A-Fa-f]*\\)" .
     ((1 'xcompose-U-face) (2 'xcompose-num-face)))
    (":" . 'xcompose-colon-face)
    ;; I want to be able to open my "base" files too, and automatically
    ;; de-emphasize (comment-out) things that won't be expanded (because of
    ;; too long a string.)
    ("^.*{[^}]\\{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.")
 
;; I wonder if this will be useful or really annoying.
(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)
 
;; See https://emacs.stackexchange.com/questions/51216/how-to-expand-abbrevs-without-hitting-another-extra-key
(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)))
 
;; Not really all that useful, since I can fill in the comment automatically
(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)))
 
;; If you can type the char but don't know its code (using C-x 8 RET is
;; great for this, if you know the character name)
(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))))
 
;; Conversely, if you know the character code but for some reason can't
;; type it (C-x 8 RET not working for you?) you can do it the other way.
(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."
  ;; Probably needs some reformatting afterwards
  (interactive)
  (let* ((pos (or pos (point)))
         (eol (progn (end-of-line) (point)))
         (bol (progn (beginning-of-line) (point))))
    ;; search not necessarily as precise
    (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-start "\\s-#")
  (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)
  )