]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/glasses.el
Rearranged the order in which the tag-*-match-p functions are defined,
[gnu-emacs] / lisp / progmodes / glasses.el
index ee66545b702e82d0a1115310e883d158a380cadc..7ba294d53af1fa6b96c47dbb7b118dbd1b619194 100644 (file)
@@ -1,9 +1,9 @@
 ;;; glasses.el --- make cantReadThis readable
 
-;; Copyright (C) 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
 
-;; Author: Milan Zamazal <pdm@freesoft.cz>
-;; Maintainer: Milan Zamazal <pdm@freesoft.cz>
+;; Author: Milan Zamazal <pdm@zamazal.org>
+;; Maintainer: Milan Zamazal <pdm@zamazal.org>
 ;; Keywords: tools
 
 ;; This file is part of GNU Emacs.
@@ -47,7 +47,7 @@
 ;; the command `M-x customize-group RET glasses RET'.
 ;;
 ;; If you set any of the variables `glasses-separator' or `glasses-face' after
-;; glasses.el is loaded and in a different way than through customize, you
+;; glasses.el is loaded in a different way than through customize, you
 ;; should call the function `glasses-set-overlay-properties' afterwards.
 
 ;;; Code:
@@ -61,7 +61,8 @@
 
 
 (defgroup glasses nil
-  "Make unreadable identifiers likeThis readable."
+  "Make unreadable code likeThis(one) readable."
+  :version "21.1"
   :group 'tools)
 
 
@@ -86,6 +87,33 @@ but will have their capitals in bold."
   :initialize 'custom-initialize-default)
 
 
+(defcustom glasses-separate-parentheses-p t
+  "*If non-nil, ensure space between an identifier and an opening parenthesis."
+  :group 'glasses
+  :type 'boolean)
+
+
+(defcustom glasses-uncapitalize-p nil
+  "*If non-nil, downcase embedded capital letters in identifiers.
+Only identifiers starting with lower case letters are affected, letters inside
+other identifiers are unchanged."
+  :group 'glasses
+  :type 'boolean
+  :set 'glasses-custom-set
+  :initialize 'custom-initialize-default)
+
+
+(defcustom glasses-uncapitalize-regexp "[a-z]"
+  "*Regexp matching beginnings of words to be uncapitalized.
+Only words starting with this regexp are uncapitalized.
+The regexp is case sensitive.
+It has any effect only when `glasses-uncapitalize-p' is non-nil."
+  :group 'glasses
+  :type 'regexp
+  :set 'glasses-custom-set
+  :initialize 'custom-initialize-default)
+
+
 (defcustom glasses-convert-on-write-p nil
   "*If non-nil, remove separators when writing glasses buffer to a file.
 If you are confused by glasses so much, that you write the separators into code
@@ -101,7 +129,7 @@ separators too."
 (defun glasses-custom-set (symbol value)
   "Set value of the variable SYMBOL to VALUE and update overlay categories.
 Used in :set parameter of some customized glasses variables."
-  (set symbol value)
+  (set-default symbol value)
   (glasses-set-overlay-properties))
 
 
@@ -117,21 +145,26 @@ Consider current setting of user variables."
   (put 'glasses 'face glasses-face)
   ;; Beg-identifier overlay
   (put 'glasses-init 'evaporate t)
-  (put 'glasses-init 'face glasses-face))
+  (put 'glasses-init 'face glasses-face)
+  ;; Parenthesis overlay
+  (put 'glasses-parenthesis 'evaporate t)
+  (put 'glasses-parenthesis 'before-string " "))
 
 (glasses-set-overlay-properties)
 
 
 (defun glasses-overlay-p (overlay)
   "Return whether OVERLAY is an overlay of glasses mode."
-  (memq (overlay-get overlay 'category) '(glasses glasses-init)))
+  (memq (overlay-get overlay 'category)
+       '(glasses glasses-init glasses-parenthesis)))
 
 
-(defun glasses-make-overlay (beg end &optional init)
-  "Create readability overlay over the region from BEG to END.
-If INIT is non-nil, put `glasses-init' overlay there."
+(defun glasses-make-overlay (beg end &optional category)
+  "Create and return readability overlay over the region from BEG to END.
+CATEGORY is the overlay category.  If it is nil, use the `glasses' category."
   (let ((overlay (make-overlay beg end)))
-    (overlay-put overlay 'category (if init 'glasses-init 'glasses))))
+    (overlay-put overlay 'category (or category 'glasses))
+    overlay))
 
 
 (defun glasses-make-readable (beg end)
@@ -144,14 +177,30 @@ If INIT is non-nil, put `glasses-init' overlay there."
        (while (re-search-forward
                "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)"
                end t)
-         (glasses-make-overlay (match-beginning 1) (match-end 1) t))
-       (goto-char beg)
+         (glasses-make-overlay (match-beginning 1) (match-end 1)
+                               'glasses-init))
        ;; Face + separator
+       (goto-char beg)
        (while (re-search-forward "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
                                  end t)
-         (let ((n (if (match-string 1) 1 2)))
-           (glasses-make-overlay (match-beginning n) (match-end n))
-           (goto-char (match-beginning n))))))))
+         (let* ((n (if (match-string 1) 1 2))
+                (o (glasses-make-overlay (match-beginning n) (match-end n))))
+           (goto-char (match-beginning n))
+           (when (and glasses-uncapitalize-p
+                      (save-match-data
+                        (looking-at "[A-Z]\\($\\|[^A-Z]\\)"))
+                      (save-excursion
+                        (save-match-data
+                          (re-search-backward "\\<.")
+                          (looking-at glasses-uncapitalize-regexp))))
+             (overlay-put o 'invisible t)
+             (overlay-put o 'after-string (downcase (match-string n))))))
+       ;; Parentheses
+       (when glasses-separate-parentheses-p
+         (goto-char beg)
+         (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t)
+           (glasses-make-overlay (match-beginning 1) (match-end 1)
+                                 'glasses-parenthesis)))))))
 
 
 (defun glasses-make-unreadable (beg end)
@@ -167,19 +216,26 @@ This function modifies buffer contents, it removes all the separators,
 recognized according to the current value of the variable `glasses-separator'."
   (when (and glasses-convert-on-write-p
             (not (string= glasses-separator "")))
-    (let ((case-fold-search nil))
+    (let ((case-fold-search nil)
+         (separator (regexp-quote glasses-separator)))
       (save-excursion
        (goto-char (point-min))
        (while (re-search-forward
-               "[a-z]\\(_\\)[A-Z]\\|[A-Z]\\(_\\)[A-Z][a-z]" nil t)
+               (format "[a-z]\\(%s\\)[A-Z]\\|[A-Z]\\(%s\\)[A-Z][a-z]"
+                       separator separator)
+               nil t)
          (let ((n (if (match-string 1) 1 2)))
            (replace-match "" t nil nil n)
-           (goto-char (match-end n)))))))
+           (goto-char (match-end n))))
+       (when glasses-separate-parentheses-p
+         (goto-char (point-min))
+         (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t)
+           (replace-match "" t nil nil 1))))))
   ;; nil must be returned to allow use in write file hooks
   nil)
 
 
-(defun glasses-change (beg end old-len)
+(defun glasses-change (beg end &optional old-len)
   "After-change function updating glass overlays."
   (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
        (end-line (save-excursion (goto-char end) (line-end-position))))
@@ -190,38 +246,26 @@ recognized according to the current value of the variable `glasses-separator'."
 ;;; Minor mode definition
 
 
-(defvar glasses-mode nil
-  "Mode variable for `glasses-mode'.")
-(make-variable-buffer-local 'glasses-mode)
-
-(add-to-list 'minor-mode-alist '(glasses-mode " o^o"))
-
-
 ;;;###autoload
-(defun glasses-mode (arg)
+(define-minor-mode glasses-mode
   "Minor mode for making identifiers likeThis readable.
 When this mode is active, it tries to add virtual separators (like underscores)
 at places they belong to."
-  (interactive "P")
-  (let ((new-flag (if (null arg)
-                      (not glasses-mode)
-                   (> (prefix-numeric-value arg) 0))))
-    (unless (eq new-flag glasses-mode)
-      (save-excursion
-       (save-restriction
-         (widen)
-         (if new-flag
-             (progn
-               (glasses-make-readable (point-min) (point-max))
-               (make-local-hook 'after-change-functions)
-               (add-hook 'after-change-functions 'glasses-change nil t)
-               (add-hook 'local-write-file-hooks
-                         'glasses-convert-to-unreadable nil t))
-           (glasses-make-unreadable (point-min) (point-max))
-           (remove-hook 'after-change-functions 'glasses-change t)
-           (remove-hook 'local-write-file-hooks
-                        'glasses-convert-to-unreadable t))))
-      (setq glasses-mode new-flag))))
+  nil " o^o" nil
+  (save-excursion
+    (save-restriction
+      (widen)
+      ;; We erase all the overlays anyway, to avoid dual sight in some
+      ;; circumstances
+      (glasses-make-unreadable (point-min) (point-max))
+      (if glasses-mode
+         (progn
+           (jit-lock-register 'glasses-change)
+           (add-hook 'local-write-file-hooks
+                     'glasses-convert-to-unreadable nil t))
+       (jit-lock-unregister 'glasses-change)
+       (remove-hook 'local-write-file-hooks
+                    'glasses-convert-to-unreadable t)))))
 
 
 ;;; Announce