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