Commit | Line | Data |
---|---|---|
efd68b8a GM |
1 | ;;; glasses.el --- make cantReadThis readable |
2 | ||
e1ac4066 | 3 | ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. |
efd68b8a | 4 | |
7aee34d3 GM |
5 | ;; Author: Milan Zamazal <pdm@zamazal.org> |
6 | ;; Maintainer: Milan Zamazal <pdm@zamazal.org> | |
efd68b8a GM |
7 | ;; Keywords: tools |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
efd68b8a | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
efd68b8a GM |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
efd68b8a GM |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This file defines a minor mode for making unreadableIdentifiersLikeThis | |
27 | ;; readable. In some environments, for instance Java, it is common to use such | |
28 | ;; unreadable identifiers. It is not good to use underscores in identifiers of | |
29 | ;; your own project in such an environment to make your sources more readable, | |
30 | ;; since it introduces undesirable confusion, which is worse than the | |
31 | ;; unreadability. Fortunately, you use Emacs for the subproject, so the | |
32 | ;; problem can be solved some way. | |
33 | ;; | |
34 | ;; This file defines the `glasses-mode' minor mode, which displays underscores | |
35 | ;; between all the pairs of lower and upper English letters. (This only | |
36 | ;; displays underscores, the text is not changed actually.) Alternatively, you | |
37 | ;; can say you want the capitals in some given face (e.g. bold). | |
38 | ;; | |
39 | ;; The mode does something usable, though not perfect. Improvement suggestions | |
40 | ;; from Emacs experts are welcome. | |
41 | ;; | |
42 | ;; If you like in-identifier separators different from underscores, change the | |
43 | ;; value of the variable `glasses-separator' appropriately. See also the | |
44 | ;; variables `glasses-face' and `glasses-convert-on-write-p'. You can also use | |
45 | ;; the command `M-x customize-group RET glasses RET'. | |
46 | ;; | |
47 | ;; If you set any of the variables `glasses-separator' or `glasses-face' after | |
170c1b26 | 48 | ;; glasses.el is loaded in a different way than through customize, you |
efd68b8a GM |
49 | ;; should call the function `glasses-set-overlay-properties' afterwards. |
50 | ||
51 | ;;; Code: | |
52 | ||
53 | ||
54 | (eval-when-compile | |
55 | (require 'cl)) | |
56 | ||
57 | ||
58 | ;;; User variables | |
59 | ||
60 | ||
61 | (defgroup glasses nil | |
170c1b26 | 62 | "Make unreadable code likeThis(one) readable." |
c17c99ad | 63 | :version "21.1" |
efd68b8a GM |
64 | :group 'tools) |
65 | ||
66 | ||
67 | (defcustom glasses-separator "_" | |
c57a573f | 68 | "String to be displayed as a visual separator in identifiers. |
08108577 EZ |
69 | It is used both for adding missing separators and for replacing separators |
70 | defined by `glasses-original-separator'. If you don't want to add missing | |
71 | separators, set `glasses-separator' to an empty string. If you don't want to | |
72 | replace existent separators, set `glasses-original-separator' to an empty | |
73 | string." | |
efd68b8a GM |
74 | :group 'glasses |
75 | :type 'string | |
76 | :set 'glasses-custom-set | |
77 | :initialize 'custom-initialize-default) | |
78 | ||
79 | ||
08108577 EZ |
80 | (defcustom glasses-original-separator "_" |
81 | "*String to be displayed as `glasses-separator' in separator positions. | |
82 | For instance, if you set it to \"_\" and set `glasses-separator' to \"-\", | |
83 | underscore separators are displayed as hyphens. | |
84 | If `glasses-original-separator' is an empty string, no such display change is | |
85 | performed." | |
86 | :group 'glasses | |
87 | :type 'string | |
88 | :set 'glasses-custom-set | |
89 | :initialize 'custom-initialize-default | |
90 | :version "22.1") | |
91 | ||
92 | ||
efd68b8a | 93 | (defcustom glasses-face nil |
c57a573f | 94 | "Face to be put on capitals of an identifier looked through glasses. |
efd68b8a GM |
95 | If it is nil, no face is placed at the capitalized letter. |
96 | ||
97 | For example, you can set `glasses-separator' to an empty string and | |
98 | `glasses-face' to `bold'. Then unreadable identifiers will have no separators, | |
99 | but will have their capitals in bold." | |
100 | :group 'glasses | |
deefca64 | 101 | :type '(choice (const :tag "None" nil) face) |
efd68b8a GM |
102 | :set 'glasses-custom-set |
103 | :initialize 'custom-initialize-default) | |
104 | ||
105 | ||
170c1b26 | 106 | (defcustom glasses-separate-parentheses-p t |
c57a573f | 107 | "If non-nil, ensure space between an identifier and an opening parenthesis." |
170c1b26 GM |
108 | :group 'glasses |
109 | :type 'boolean) | |
110 | ||
014d32b1 JB |
111 | (defcustom glasses-separate-parentheses-exceptions |
112 | '("^#[\t ]*define[\t ]*[A-Za-z0-9_-]* ?($") | |
113 | "List of regexp that are exceptions for `glasses-separate-parentheses-p'. | |
114 | They are matched to the current line truncated to the point where the | |
115 | parenthesis expression starts." | |
116 | :group 'glasses | |
117 | :type '(repeat regexp)) | |
170c1b26 | 118 | |
9c1d5ac5 MZ |
119 | (defcustom glasses-separate-capital-groups t |
120 | "If non-nil, try to separate groups of capital letters. | |
121 | When the value is non-nil, HTMLSomething and IPv6 are displayed | |
122 | as HTML_Something and I_Pv6 respectively. Set the value to nil | |
123 | if you prefer to display them unchanged." | |
124 | :group 'glasses | |
125 | :type 'boolean | |
126 | :version "24.1") | |
127 | ||
170c1b26 | 128 | (defcustom glasses-uncapitalize-p nil |
c57a573f | 129 | "If non-nil, downcase embedded capital letters in identifiers. |
170c1b26 GM |
130 | Only identifiers starting with lower case letters are affected, letters inside |
131 | other identifiers are unchanged." | |
132 | :group 'glasses | |
133 | :type 'boolean | |
134 | :set 'glasses-custom-set | |
135 | :initialize 'custom-initialize-default) | |
136 | ||
137 | ||
138 | (defcustom glasses-uncapitalize-regexp "[a-z]" | |
c57a573f | 139 | "Regexp matching beginnings of words to be uncapitalized. |
170c1b26 GM |
140 | Only words starting with this regexp are uncapitalized. |
141 | The regexp is case sensitive. | |
142 | It has any effect only when `glasses-uncapitalize-p' is non-nil." | |
143 | :group 'glasses | |
144 | :type 'regexp | |
145 | :set 'glasses-custom-set | |
146 | :initialize 'custom-initialize-default) | |
147 | ||
148 | ||
efd68b8a | 149 | (defcustom glasses-convert-on-write-p nil |
c57a573f | 150 | "If non-nil, remove separators when writing glasses buffer to a file. |
efd68b8a GM |
151 | If you are confused by glasses so much, that you write the separators into code |
152 | during coding, set this variable to t. The separators will be removed on each | |
153 | file write then. | |
154 | ||
155 | Note the removal action does not try to be much clever, so it can remove real | |
156 | separators too." | |
157 | :group 'glasses | |
158 | :type 'boolean) | |
159 | ||
160 | ||
161 | (defun glasses-custom-set (symbol value) | |
162 | "Set value of the variable SYMBOL to VALUE and update overlay categories. | |
163 | Used in :set parameter of some customized glasses variables." | |
c17c99ad | 164 | (set-default symbol value) |
efd68b8a GM |
165 | (glasses-set-overlay-properties)) |
166 | ||
167 | ||
168 | ;;; Utility functions | |
169 | ||
014d32b1 JB |
170 | (defun glasses-parenthesis-exception-p (beg end) |
171 | "Tell if (BEG, END) is an exception to `glasses-separate-parentheses-p'. | |
172 | See `glasses-separate-parentheses-exceptions'." | |
173 | (save-match-data | |
174 | (let ((str (buffer-substring beg end))) | |
175 | (catch 'match | |
176 | (dolist (re glasses-separate-parentheses-exceptions) | |
177 | (and (string-match re str) (throw 'match t))))))) | |
efd68b8a GM |
178 | |
179 | (defun glasses-set-overlay-properties () | |
180 | "Set properties of glasses overlays. | |
181 | Consider current setting of user variables." | |
182 | ;; In-identifier overlay | |
183 | (put 'glasses 'evaporate t) | |
184 | (put 'glasses 'before-string glasses-separator) | |
185 | (put 'glasses 'face glasses-face) | |
186 | ;; Beg-identifier overlay | |
187 | (put 'glasses-init 'evaporate t) | |
170c1b26 GM |
188 | (put 'glasses-init 'face glasses-face) |
189 | ;; Parenthesis overlay | |
190 | (put 'glasses-parenthesis 'evaporate t) | |
191 | (put 'glasses-parenthesis 'before-string " ")) | |
efd68b8a GM |
192 | |
193 | (glasses-set-overlay-properties) | |
194 | ||
195 | ||
196 | (defun glasses-overlay-p (overlay) | |
197 | "Return whether OVERLAY is an overlay of glasses mode." | |
170c1b26 GM |
198 | (memq (overlay-get overlay 'category) |
199 | '(glasses glasses-init glasses-parenthesis))) | |
efd68b8a GM |
200 | |
201 | ||
170c1b26 GM |
202 | (defun glasses-make-overlay (beg end &optional category) |
203 | "Create and return readability overlay over the region from BEG to END. | |
204 | CATEGORY is the overlay category. If it is nil, use the `glasses' category." | |
efd68b8a | 205 | (let ((overlay (make-overlay beg end))) |
170c1b26 GM |
206 | (overlay-put overlay 'category (or category 'glasses)) |
207 | overlay)) | |
efd68b8a GM |
208 | |
209 | ||
210 | (defun glasses-make-readable (beg end) | |
211 | "Make identifiers in the region from BEG to END readable." | |
212 | (let ((case-fold-search nil)) | |
213 | (save-excursion | |
214 | (save-match-data | |
215 | ;; Face only | |
216 | (goto-char beg) | |
217 | (while (re-search-forward | |
218 | "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)" | |
219 | end t) | |
170c1b26 GM |
220 | (glasses-make-overlay (match-beginning 1) (match-end 1) |
221 | 'glasses-init)) | |
efd68b8a | 222 | ;; Face + separator |
170c1b26 | 223 | (goto-char beg) |
9c1d5ac5 MZ |
224 | (while (re-search-forward |
225 | (if glasses-separate-capital-groups | |
226 | "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]" | |
227 | "[a-z]\\([A-Z]\\)") | |
228 | end t) | |
170c1b26 GM |
229 | (let* ((n (if (match-string 1) 1 2)) |
230 | (o (glasses-make-overlay (match-beginning n) (match-end n)))) | |
231 | (goto-char (match-beginning n)) | |
232 | (when (and glasses-uncapitalize-p | |
15cca6c4 GM |
233 | (save-match-data |
234 | (looking-at "[A-Z]\\($\\|[^A-Z]\\)")) | |
170c1b26 GM |
235 | (save-excursion |
236 | (save-match-data | |
237 | (re-search-backward "\\<.") | |
238 | (looking-at glasses-uncapitalize-regexp)))) | |
239 | (overlay-put o 'invisible t) | |
240 | (overlay-put o 'after-string (downcase (match-string n)))))) | |
debe6451 | 241 | ;; Separator change |
08108577 EZ |
242 | (when (and (not (string= glasses-original-separator glasses-separator)) |
243 | (not (string= glasses-original-separator ""))) | |
debe6451 | 244 | (goto-char beg) |
08108577 EZ |
245 | (let ((original-regexp (regexp-quote glasses-original-separator))) |
246 | (while (re-search-forward | |
247 | (format "[a-zA-Z0-9]\\(\\(%s\\)+\\)[a-zA-Z0-9]" | |
248 | original-regexp) | |
249 | end t) | |
250 | (goto-char (match-beginning 1)) | |
251 | (while (looking-at original-regexp) | |
252 | (let ((o (glasses-make-overlay (point) (1+ (point))))) | |
253 | ;; `concat' ensures the character properties won't merge | |
254 | (overlay-put o 'display (concat glasses-separator))) | |
255 | (goto-char (match-end 0)))))) | |
170c1b26 GM |
256 | ;; Parentheses |
257 | (when glasses-separate-parentheses-p | |
258 | (goto-char beg) | |
7aee34d3 | 259 | (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t) |
014d32b1 JB |
260 | (unless (glasses-parenthesis-exception-p (point-at-bol) (match-end 1)) |
261 | (glasses-make-overlay (match-beginning 1) (match-end 1) | |
262 | 'glasses-parenthesis)))))))) | |
efd68b8a GM |
263 | |
264 | ||
265 | (defun glasses-make-unreadable (beg end) | |
266 | "Return identifiers in the region from BEG to END to their unreadable state." | |
267 | (dolist (o (overlays-in beg end)) | |
268 | (when (glasses-overlay-p o) | |
269 | (delete-overlay o)))) | |
270 | ||
271 | ||
272 | (defun glasses-convert-to-unreadable () | |
273 | "Convert current buffer to unreadable identifiers and return nil. | |
274 | This function modifies buffer contents, it removes all the separators, | |
275 | recognized according to the current value of the variable `glasses-separator'." | |
014d32b1 | 276 | (when glasses-convert-on-write-p |
971c5b28 GM |
277 | (let ((case-fold-search nil) |
278 | (separator (regexp-quote glasses-separator))) | |
efd68b8a | 279 | (save-excursion |
014d32b1 | 280 | (unless (string= glasses-separator "") |
08108577 | 281 | (goto-char (point-min)) |
014d32b1 JB |
282 | (while (re-search-forward |
283 | (format "[a-z]\\(%s\\)[A-Z]\\|[A-Z]\\(%s\\)[A-Z][a-z]" | |
284 | separator separator) | |
285 | nil t) | |
286 | (let ((n (if (match-string 1) 1 2))) | |
287 | (replace-match "" t nil nil n) | |
288 | (goto-char (match-end n)))) | |
289 | (unless (string= glasses-separator glasses-original-separator) | |
290 | (goto-char (point-min)) | |
291 | (while (re-search-forward (format "[a-zA-Z0-9]\\(%s+\\)[a-zA-Z0-9]" | |
292 | separator) | |
293 | nil t) | |
294 | (replace-match glasses-original-separator nil nil nil 1) | |
295 | (goto-char (match-beginning 1))))) | |
170c1b26 GM |
296 | (when glasses-separate-parentheses-p |
297 | (goto-char (point-min)) | |
a21822f8 | 298 | (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t) |
014d32b1 JB |
299 | (unless (glasses-parenthesis-exception-p (point-at-bol) (1+ (match-end 1))) |
300 | (replace-match "" t nil nil 1))))))) | |
efd68b8a GM |
301 | ;; nil must be returned to allow use in write file hooks |
302 | nil) | |
303 | ||
304 | ||
e02f48d7 | 305 | (defun glasses-change (beg end &optional _old-len) |
efd68b8a GM |
306 | "After-change function updating glass overlays." |
307 | (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position))) | |
308 | (end-line (save-excursion (goto-char end) (line-end-position)))) | |
309 | (glasses-make-unreadable beg-line end-line) | |
310 | (glasses-make-readable beg-line end-line))) | |
311 | ||
312 | ||
313 | ;;; Minor mode definition | |
314 | ||
315 | ||
efd68b8a | 316 | ;;;###autoload |
5610cefd | 317 | (define-minor-mode glasses-mode |
efd68b8a | 318 | "Minor mode for making identifiers likeThis readable. |
e1ac4066 GM |
319 | With a prefix argument ARG, enable the mode if ARG is positive, |
320 | and disable it otherwise. If called from Lisp, enable the mode | |
321 | if ARG is omitted or nil. When this mode is active, it tries to | |
322 | add virtual separators (like underscores) at places they belong to." | |
3b614b81 | 323 | :group 'glasses :lighter " o^o" |
5610cefd GM |
324 | (save-excursion |
325 | (save-restriction | |
326 | (widen) | |
327 | ;; We erase all the overlays anyway, to avoid dual sight in some | |
328 | ;; circumstances | |
329 | (glasses-make-unreadable (point-min) (point-max)) | |
330 | (if glasses-mode | |
331 | (progn | |
332 | (jit-lock-register 'glasses-change) | |
333 | (add-hook 'local-write-file-hooks | |
334 | 'glasses-convert-to-unreadable nil t)) | |
335 | (jit-lock-unregister 'glasses-change) | |
336 | (remove-hook 'local-write-file-hooks | |
337 | 'glasses-convert-to-unreadable t))))) | |
efd68b8a GM |
338 | |
339 | ||
340 | ;;; Announce | |
341 | ||
342 | (provide 'glasses) | |
343 | ||
344 | ||
345 | ;;; glasses.el ends here |