lisp/progmodes/glasses.el

   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 3, 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.
  72 It is used both for adding missing separators and for replacing separators
  73 defined by `glasses-original-separator'.  If you don't want to add missing
  74 separators, set `glasses-separator' to an empty string.  If you don't want to
  75 replace existent separators, set `glasses-original-separator' to an empty
  76 string."
  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.
  85 For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
  86 underscore separators are displayed as hyphens.
  87 If `glasses-original-separator' is an empty string, no such display change is
  88 performed."
  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.
  98 If it is nil, no face is placed at the capitalized letter.
  99
 100 For example, you can set `glasses-separator' to an empty string and
 101 `glasses-face' to `bold'.  Then unreadable identifiers will have no separators,
 102 but 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'.
 117 They are matched to the current line truncated to the point where the
 118 parenthesis 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.
 124 Only identifiers starting with lower case letters are affected, letters inside
 125 other 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.
 134 Only words starting with this regexp are uncapitalized.
 135 The regexp is case sensitive.
 136 It 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.
 145 If you are confused by glasses so much, that you write the separators into code
 146 during coding, set this variable to t.  The separators will be removed on each
 147 file write then.
 148
 149 Note the removal action does not try to be much clever, so it can remove real
 150 separators 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.
 157 Used 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'.
 166 See `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.
 175 Consider 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.
 198 CATEGORY 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.
 265 This function modifies buffer contents, it removes all the separators,
 266 recognized 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.
 310 When this mode is active, it tries to add virtual separators (like underscores)
 311 at 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