;;; 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.
;; 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:
(defgroup glasses nil
- "Make unreadable identifiers likeThis readable."
+ "Make unreadable code likeThis(one) readable."
+ :version "21.1"
:group 'tools)
: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
(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))
(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)
(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)
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))))
;;; 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