lisp/progmodes/glasses.el

   1 ;;; glasses.el --- make cantReadThis readable
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2005, 2006 Free Software Foundation, Inc.
   4
   5 ;; Author: Milan Zamazal <pdm@zamazal.org>
   6 ;; Maintainer: Milan Zamazal <pdm@zamazal.org>
   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., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, 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 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 code likeThis(one) readable."
  65   :version "21.1"
  66   :group 'tools)
  67
  68
  69 (defcustom glasses-separator "_"
  70   "String to be displayed as a visual separator in identifiers.
  71 It is used both for adding missing separators and for replacing separators
  72 defined by `glasses-original-separator'.  If you don't want to add missing
  73 separators, set `glasses-separator' to an empty string.  If you don't want to
  74 replace existent separators, set `glasses-original-separator' to an empty
  75 string."
  76   :group 'glasses
  77   :type 'string
  78   :set 'glasses-custom-set
  79   :initialize 'custom-initialize-default)
  80
  81
  82 (defcustom glasses-original-separator "_"
  83   "*String to be displayed as `glasses-separator' in separator positions.
  84 For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
  85 underscore separators are displayed as hyphens.
  86 If `glasses-original-separator' is an empty string, no such display change is
  87 performed."
  88   :group 'glasses
  89   :type 'string
  90   :set 'glasses-custom-set
  91   :initialize 'custom-initialize-default
  92   :version "22.1")
  93
  94
  95 (defcustom glasses-face nil
  96   "Face to be put on capitals of an identifier looked through glasses.
  97 If it is nil, no face is placed at the capitalized letter.
  98
  99 For example, you can set `glasses-separator' to an empty string and
 100 `glasses-face' to `bold'.  Then unreadable identifiers will have no separators,
 101 but will have their capitals in bold."
 102   :group 'glasses
 103   :type '(choice (const :tag "None" nil) face)
 104   :set 'glasses-custom-set
 105   :initialize 'custom-initialize-default)
 106
 107
 108 (defcustom glasses-separate-parentheses-p t
 109   "If non-nil, ensure space between an identifier and an opening parenthesis."
 110   :group 'glasses
 111   :type 'boolean)
 112
 113
 114 (defcustom glasses-uncapitalize-p nil
 115   "If non-nil, downcase embedded capital letters in identifiers.
 116 Only identifiers starting with lower case letters are affected, letters inside
 117 other identifiers are unchanged."
 118   :group 'glasses
 119   :type 'boolean
 120   :set 'glasses-custom-set
 121   :initialize 'custom-initialize-default)
 122
 123
 124 (defcustom glasses-uncapitalize-regexp "[a-z]"
 125   "Regexp matching beginnings of words to be uncapitalized.
 126 Only words starting with this regexp are uncapitalized.
 127 The regexp is case sensitive.
 128 It has any effect only when `glasses-uncapitalize-p' is non-nil."
 129   :group 'glasses
 130   :type 'regexp
 131   :set 'glasses-custom-set
 132   :initialize 'custom-initialize-default)
 133
 134
 135 (defcustom glasses-convert-on-write-p nil
 136   "If non-nil, remove separators when writing glasses buffer to a file.
 137 If you are confused by glasses so much, that you write the separators into code
 138 during coding, set this variable to t.  The separators will be removed on each
 139 file write then.
 140
 141 Note the removal action does not try to be much clever, so it can remove real
 142 separators too."
 143   :group 'glasses
 144   :type 'boolean)
 145
 146
 147 (defun glasses-custom-set (symbol value)
 148   "Set value of the variable SYMBOL to VALUE and update overlay categories.
 149 Used in :set parameter of some customized glasses variables."
 150   (set-default symbol value)
 151   (glasses-set-overlay-properties))
 152
 153
 154 ;;; Utility functions
 155
 156
 157 (defun glasses-set-overlay-properties ()
 158   "Set properties of glasses overlays.
 159 Consider current setting of user variables."
 160   ;; In-identifier overlay
 161   (put 'glasses 'evaporate t)
 162   (put 'glasses 'before-string glasses-separator)
 163   (put 'glasses 'face glasses-face)
 164   ;; Beg-identifier overlay
 165   (put 'glasses-init 'evaporate t)
 166   (put 'glasses-init 'face glasses-face)
 167   ;; Parenthesis overlay
 168   (put 'glasses-parenthesis 'evaporate t)
 169   (put 'glasses-parenthesis 'before-string " "))
 170
 171 (glasses-set-overlay-properties)
 172
 173
 174 (defun glasses-overlay-p (overlay)
 175   "Return whether OVERLAY is an overlay of glasses mode."
 176   (memq (overlay-get overlay 'category)
 177         '(glasses glasses-init glasses-parenthesis)))
 178
 179
 180 (defun glasses-make-overlay (beg end &optional category)
 181   "Create and return readability overlay over the region from BEG to END.
 182 CATEGORY is the overlay category.  If it is nil, use the `glasses' category."
 183   (let ((overlay (make-overlay beg end)))
 184     (overlay-put overlay 'category (or category 'glasses))
 185     overlay))
 186
 187
 188 (defun glasses-make-readable (beg end)
 189   "Make identifiers in the region from BEG to END readable."
 190   (let ((case-fold-search nil))
 191     (save-excursion
 192       (save-match-data
 193         ;; Face only
 194         (goto-char beg)
 195         (while (re-search-forward
 196                 "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)"
 197                 end t)
 198           (glasses-make-overlay (match-beginning 1) (match-end 1)
 199                                 'glasses-init))
 200         ;; Face + separator
 201         (goto-char beg)
 202         (while (re-search-forward "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
 203                                   end t)
 204           (let* ((n (if (match-string 1) 1 2))
 205                  (o (glasses-make-overlay (match-beginning n) (match-end n))))
 206             (goto-char (match-beginning n))
 207             (when (and glasses-uncapitalize-p
 208                        (save-match-data
 209                          (looking-at "[A-Z]\\($\\|[^A-Z]\\)"))
 210                        (save-excursion
 211                          (save-match-data
 212                            (re-search-backward "\\<.")
 213                            (looking-at glasses-uncapitalize-regexp))))
 214               (overlay-put o 'invisible t)
 215               (overlay-put o 'after-string (downcase (match-string n))))))
 216         ;; Separator change
 217         (when (and (not (string= glasses-original-separator glasses-separator))
 218                    (not (string= glasses-original-separator "")))
 219           (goto-char beg)
 220           (let ((original-regexp (regexp-quote glasses-original-separator)))
 221             (while (re-search-forward
 222                     (format "[a-zA-Z0-9]\\(\\(%s\\)+\\)[a-zA-Z0-9]"
 223                             original-regexp)
 224                     end t)
 225               (goto-char (match-beginning 1))
 226               (while (looking-at original-regexp)
 227                 (let ((o (glasses-make-overlay (point) (1+ (point)))))
 228                   ;; `concat' ensures the character properties won't merge
 229                   (overlay-put o 'display (concat glasses-separator)))
 230                 (goto-char (match-end 0))))))
 231         ;; Parentheses
 232         (when glasses-separate-parentheses-p
 233           (goto-char beg)
 234           (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t)
 235             (glasses-make-overlay (match-beginning 1) (match-end 1)
 236                                   'glasses-parenthesis)))))))
 237
 238
 239 (defun glasses-make-unreadable (beg end)
 240   "Return identifiers in the region from BEG to END to their unreadable state."
 241   (dolist (o (overlays-in beg end))
 242     (when (glasses-overlay-p o)
 243       (delete-overlay o))))
 244
 245
 246 (defun glasses-convert-to-unreadable ()
 247   "Convert current buffer to unreadable identifiers and return nil.
 248 This function modifies buffer contents, it removes all the separators,
 249 recognized according to the current value of the variable `glasses-separator'."
 250   (when (and glasses-convert-on-write-p
 251              (not (string= glasses-separator "")))
 252     (let ((case-fold-search nil)
 253           (separator (regexp-quote glasses-separator)))
 254       (save-excursion
 255         (goto-char (point-min))
 256         (while (re-search-forward
 257                 (format "[a-z]\\(%s\\)[A-Z]\\|[A-Z]\\(%s\\)[A-Z][a-z]"
 258                         separator separator)
 259                 nil t)
 260           (let ((n (if (match-string 1) 1 2)))
 261             (replace-match "" t nil nil n)
 262             (goto-char (match-end n))))
 263         (unless (string= glasses-separator glasses-original-separator)
 264           (goto-char (point-min))
 265           (while (re-search-forward (format "[a-zA-Z0-9]\\(%s+\\)[a-zA-Z0-9]"
 266                                             separator)
 267                                     nil t)
 268             (replace-match glasses-original-separator nil nil nil 1)
 269             (goto-char (match-beginning 1))))
 270         (when glasses-separate-parentheses-p
 271           (goto-char (point-min))
 272           (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t)
 273             (replace-match "" t nil nil 1))))))
 274   ;; nil must be returned to allow use in write file hooks
 275   nil)
 276
 277
 278 (defun glasses-change (beg end &optional old-len)
 279   "After-change function updating glass overlays."
 280   (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
 281         (end-line (save-excursion (goto-char end) (line-end-position))))
 282     (glasses-make-unreadable beg-line end-line)
 283     (glasses-make-readable beg-line end-line)))
 284
 285
 286 ;;; Minor mode definition
 287
 288
 289 ;;;###autoload
 290 (define-minor-mode glasses-mode
 291   "Minor mode for making identifiers likeThis readable.
 292 When this mode is active, it tries to add virtual separators (like underscores)
 293 at places they belong to."
 294   :group 'glasses :lighter " o^o"
 295   (save-excursion
 296     (save-restriction
 297       (widen)
 298       ;; We erase all the overlays anyway, to avoid dual sight in some
 299       ;; circumstances
 300       (glasses-make-unreadable (point-min) (point-max))
 301       (if glasses-mode
 302           (progn
 303             (jit-lock-register 'glasses-change)
 304             (add-hook 'local-write-file-hooks
 305                       'glasses-convert-to-unreadable nil t))
 306         (jit-lock-unregister 'glasses-change)
 307         (remove-hook 'local-write-file-hooks
 308                      'glasses-convert-to-unreadable t)))))
 309
 310
 311 ;;; Announce
 312
 313 (provide 'glasses)
 314
 315
 316 ;; arch-tag: a3515167-c89e-484f-90a1-d85143e52b12
 317 ;;; glasses.el ends here