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