Mercurial > emacs
comparison lisp/progmodes/glasses.el @ 27469:98f24cb3efa5
*** empty log message ***
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Fri, 28 Jan 2000 12:48:41 +0000 |
parents | |
children | 809168962c9b |
comparison
equal
deleted
inserted
replaced
27468:8a6ee5b485d2 | 27469:98f24cb3efa5 |
---|---|
1 ;;; glasses.el --- make cantReadThis readable | |
2 | |
3 ;; Copyright (C) 1999 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Milan Zamazal <pdm@freesoft.cz> | |
6 ;; Maintainer: Milan Zamazal <pdm@freesoft.cz> | |
7 ;; Keywords: tools | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
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 | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This file defines a minor mode for making unreadableIdentifiersLikeThis | |
29 ;; readable. In some environments, for instance Java, it is common to use such | |
30 ;; unreadable identifiers. It is not good to use underscores in identifiers of | |
31 ;; your own project in such an environment to make your sources more readable, | |
32 ;; since it introduces undesirable confusion, which is worse than the | |
33 ;; unreadability. Fortunately, you use Emacs for the subproject, so the | |
34 ;; problem can be solved some way. | |
35 ;; | |
36 ;; This file defines the `glasses-mode' minor mode, which displays underscores | |
37 ;; between all the pairs of lower and upper English letters. (This only | |
38 ;; displays underscores, the text is not changed actually.) Alternatively, you | |
39 ;; can say you want the capitals in some given face (e.g. bold). | |
40 ;; | |
41 ;; The mode does something usable, though not perfect. Improvement suggestions | |
42 ;; from Emacs experts are welcome. | |
43 ;; | |
44 ;; If you like in-identifier separators different from underscores, change the | |
45 ;; value of the variable `glasses-separator' appropriately. See also the | |
46 ;; variables `glasses-face' and `glasses-convert-on-write-p'. You can also use | |
47 ;; the command `M-x customize-group RET glasses RET'. | |
48 ;; | |
49 ;; If you set any of the variables `glasses-separator' or `glasses-face' after | |
50 ;; glasses.el is loaded and in a different way than through customize, you | |
51 ;; should call the function `glasses-set-overlay-properties' afterwards. | |
52 | |
53 ;;; Code: | |
54 | |
55 | |
56 (eval-when-compile | |
57 (require 'cl)) | |
58 | |
59 | |
60 ;;; User variables | |
61 | |
62 | |
63 (defgroup glasses nil | |
64 "Make unreadable identifiers likeThis readable." | |
65 :group 'tools) | |
66 | |
67 | |
68 (defcustom glasses-separator "_" | |
69 "*String to be displayed as a visual separator in unreadable identifiers." | |
70 :group 'glasses | |
71 :type 'string | |
72 :set 'glasses-custom-set | |
73 :initialize 'custom-initialize-default) | |
74 | |
75 | |
76 (defcustom glasses-face nil | |
77 "*Face to be put on capitals of an identifier looked through glasses. | |
78 If it is nil, no face is placed at the capitalized letter. | |
79 | |
80 For example, you can set `glasses-separator' to an empty string and | |
81 `glasses-face' to `bold'. Then unreadable identifiers will have no separators, | |
82 but will have their capitals in bold." | |
83 :group 'glasses | |
84 :type 'symbol | |
85 :set 'glasses-custom-set | |
86 :initialize 'custom-initialize-default) | |
87 | |
88 | |
89 (defcustom glasses-convert-on-write-p nil | |
90 "*If non-nil, remove separators when writing glasses buffer to a file. | |
91 If you are confused by glasses so much, that you write the separators into code | |
92 during coding, set this variable to t. The separators will be removed on each | |
93 file write then. | |
94 | |
95 Note the removal action does not try to be much clever, so it can remove real | |
96 separators too." | |
97 :group 'glasses | |
98 :type 'boolean) | |
99 | |
100 | |
101 (defun glasses-custom-set (symbol value) | |
102 "Set value of the variable SYMBOL to VALUE and update overlay categories. | |
103 Used in :set parameter of some customized glasses variables." | |
104 (set symbol value) | |
105 (glasses-set-overlay-properties)) | |
106 | |
107 | |
108 ;;; Utility functions | |
109 | |
110 | |
111 (defun glasses-set-overlay-properties () | |
112 "Set properties of glasses overlays. | |
113 Consider current setting of user variables." | |
114 ;; In-identifier overlay | |
115 (put 'glasses 'evaporate t) | |
116 (put 'glasses 'before-string glasses-separator) | |
117 (put 'glasses 'face glasses-face) | |
118 ;; Beg-identifier overlay | |
119 (put 'glasses-init 'evaporate t) | |
120 (put 'glasses-init 'face glasses-face)) | |
121 | |
122 (glasses-set-overlay-properties) | |
123 | |
124 | |
125 (defun glasses-overlay-p (overlay) | |
126 "Return whether OVERLAY is an overlay of glasses mode." | |
127 (memq (overlay-get overlay 'category) '(glasses glasses-init))) | |
128 | |
129 | |
130 (defun glasses-make-overlay (beg end &optional init) | |
131 "Create readability overlay over the region from BEG to END. | |
132 If INIT is non-nil, put `glasses-init' overlay there." | |
133 (let ((overlay (make-overlay beg end))) | |
134 (overlay-put overlay 'category (if init 'glasses-init 'glasses)))) | |
135 | |
136 | |
137 (defun glasses-make-readable (beg end) | |
138 "Make identifiers in the region from BEG to END readable." | |
139 (let ((case-fold-search nil)) | |
140 (save-excursion | |
141 (save-match-data | |
142 ;; Face only | |
143 (goto-char beg) | |
144 (while (re-search-forward | |
145 "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)" | |
146 end t) | |
147 (glasses-make-overlay (match-beginning 1) (match-end 1) t)) | |
148 (goto-char beg) | |
149 ;; Face + separator | |
150 (while (re-search-forward "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]" | |
151 end t) | |
152 (let ((n (if (match-string 1) 1 2))) | |
153 (glasses-make-overlay (match-beginning n) (match-end n)) | |
154 (goto-char (match-beginning n)))))))) | |
155 | |
156 | |
157 (defun glasses-make-unreadable (beg end) | |
158 "Return identifiers in the region from BEG to END to their unreadable state." | |
159 (dolist (o (overlays-in beg end)) | |
160 (when (glasses-overlay-p o) | |
161 (delete-overlay o)))) | |
162 | |
163 | |
164 (defun glasses-convert-to-unreadable () | |
165 "Convert current buffer to unreadable identifiers and return nil. | |
166 This function modifies buffer contents, it removes all the separators, | |
167 recognized according to the current value of the variable `glasses-separator'." | |
168 (when (and glasses-convert-on-write-p | |
169 (not (string= glasses-separator ""))) | |
170 (let ((case-fold-search nil)) | |
171 (save-excursion | |
172 (goto-char (point-min)) | |
173 (while (re-search-forward | |
174 "[a-z]\\(_\\)[A-Z]\\|[A-Z]\\(_\\)[A-Z][a-z]" nil t) | |
175 (let ((n (if (match-string 1) 1 2))) | |
176 (replace-match "" t nil nil n) | |
177 (goto-char (match-end n))))))) | |
178 ;; nil must be returned to allow use in write file hooks | |
179 nil) | |
180 | |
181 | |
182 (defun glasses-change (beg end old-len) | |
183 "After-change function updating glass overlays." | |
184 (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position))) | |
185 (end-line (save-excursion (goto-char end) (line-end-position)))) | |
186 (glasses-make-unreadable beg-line end-line) | |
187 (glasses-make-readable beg-line end-line))) | |
188 | |
189 | |
190 ;;; Minor mode definition | |
191 | |
192 | |
193 (defvar glasses-mode nil | |
194 "Mode variable for `glasses-mode'.") | |
195 (make-variable-buffer-local 'glasses-mode) | |
196 | |
197 (add-to-list 'minor-mode-alist '(glasses-mode " o^o")) | |
198 | |
199 | |
200 ;;;###autoload | |
201 (defun glasses-mode (arg) | |
202 "Minor mode for making identifiers likeThis readable. | |
203 When this mode is active, it tries to add virtual separators (like underscores) | |
204 at places they belong to." | |
205 (interactive "P") | |
206 (let ((new-flag (if (null arg) | |
207 (not glasses-mode) | |
208 (> (prefix-numeric-value arg) 0)))) | |
209 (unless (eq new-flag glasses-mode) | |
210 (save-excursion | |
211 (save-restriction | |
212 (widen) | |
213 (if new-flag | |
214 (progn | |
215 (glasses-make-readable (point-min) (point-max)) | |
216 (make-local-hook 'after-change-functions) | |
217 (add-hook 'after-change-functions 'glasses-change nil t) | |
218 (add-hook 'local-write-file-hooks | |
219 'glasses-convert-to-unreadable nil t)) | |
220 (glasses-make-unreadable (point-min) (point-max)) | |
221 (remove-hook 'after-change-functions 'glasses-change t) | |
222 (remove-hook 'local-write-file-hooks | |
223 'glasses-convert-to-unreadable t)))) | |
224 (setq glasses-mode new-flag)))) | |
225 | |
226 | |
227 ;;; Announce | |
228 | |
229 (provide 'glasses) | |
230 | |
231 | |
232 ;;; glasses.el ends here |