lisp/progmodes/glasses.el

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