/[emacs]/emacs/lisp/whitespace.el
ViewVC logotype

Diff of /emacs/lisp/whitespace.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by rv, Mon Aug 20 20:56:08 2001 UTC revision 1.19 by rv, Thu Dec 13 17:34:57 2001 UTC
# Line 39  Line 39 
39    
40  ;;; Code:  ;;; Code:
41    
42  (defvar whitespace-version "3.1" "Version of the whitespace library.")  (defvar whitespace-version "3.2" "Version of the whitespace library.")
43    
44  (defvar whitespace-all-buffer-files nil  (defvar whitespace-all-buffer-files nil
45    "An associated list of buffers and files checked for whitespace cleanliness.    "An associated list of buffers and files checked for whitespace cleanliness.
# Line 86  visited by the buffers.") Line 86  visited by the buffers.")
86  (make-variable-buffer-local 'whitespace-check-buffer-ateol)  (make-variable-buffer-local 'whitespace-check-buffer-ateol)
87  (put 'whitespace-check-buffer-ateol 'permanent-local nil)  (put 'whitespace-check-buffer-ateol 'permanent-local nil)
88    
89    (defvar whitespace-highlighted-space nil
90      "The variable to store the extent to highlight")
91    (make-variable-buffer-local 'whitespace-highlighted-space)
92    (put 'whitespace-highlighted-space 'permanent-local nil)
93    
94  ;; For flavors of Emacs which don't define `defgroup' and `defcustom'.  ;; For flavors of Emacs which don't define `defgroup' and `defcustom'.
95  (eval-when-compile  (eval-when-compile
96    (if (not (fboundp 'defgroup))    (if (not (fboundp 'defgroup))
# Line 99  defgroup" Line 104  defgroup"
104  don't define defcustom"  don't define defcustom"
105          `(defvar ,sym ,val ,doc))))          `(defvar ,sym ,val ,doc))))
106    
107    (if (fboundp 'make-overlay)
108        (progn
109          (defalias 'whitespace-make-overlay 'make-overlay)
110          (defalias 'whitespace-overlay-put 'overlay-put)
111          (defalias 'whitespace-delete-overlay 'delete-overlay)
112          (defalias 'whitespace-overlay-start 'overlay-start)
113          (defalias 'whitespace-overlay-end 'overlay-end)
114          (defalias 'whitespace-mode-line-update 'force-mode-line-update))
115      (defalias 'whitespace-make-overlay 'make-extent)
116      (defalias 'whitespace-overlay-put 'set-extent-property)
117      (defalias 'whitespace-delete-overlay 'delete-extent)
118      (defalias 'whitespace-overlay-start 'extent-start)
119      (defalias 'whitespace-overlay-end 'extent-end)
120      (defalias 'whitespace-mode-line-update 'redraw-modeline))
121    
122  (if (featurep 'xemacs)  (if (featurep 'xemacs)
123  (defgroup whitespace nil  (defgroup whitespace nil
124    "Check for and fix five different types of whitespaces in source code."    "Check for and fix five different types of whitespaces in source code."
# Line 131  It can be overriden by setting a buffer Line 151  It can be overriden by setting a buffer
151    :type 'boolean    :type 'boolean
152    :group 'whitespace)    :group 'whitespace)
153    
154  (defcustom whitespace-spacetab-regexp " \t"  (defcustom whitespace-spacetab-regexp "[ ]+\t"
155    "Regexp to match a space followed by a TAB."    "Regexp to match a space followed by a TAB."
156    :type 'regexp    :type 'regexp
157    :group 'whitespace)    :group 'whitespace)
# Line 155  It can be overriden by setting a buffer Line 175  It can be overriden by setting a buffer
175    :type 'boolean    :type 'boolean
176    :group 'whitespace)    :group 'whitespace)
177    
178  (defcustom whitespace-ateol-regexp "[ \t]$"  ;; (defcustom whitespace-ateol-regexp "[ \t]$"
179    (defcustom whitespace-ateol-regexp "[ \t]+$"
180    "Regexp to match a TAB or a space at the EOL."    "Regexp to match a TAB or a space at the EOL."
181    :type 'regexp    :type 'regexp
182    :group 'whitespace)    :group 'whitespace)
# Line 230  To disable timer scans, set this to zero Line 251  To disable timer scans, set this to zero
251    :type 'boolean    :type 'boolean
252    :group 'whitespace)    :group 'whitespace)
253    
254    (defcustom whitespace-display-spaces-in-color t
255      "Display the bogus whitespaces by coloring them with
256    `whitespace-highlight-face'."
257      :type 'boolean
258      :group 'whitespace)
259    
260    (defgroup whitespace-faces nil
261      "Faces used in whitespace."
262      :prefix "whitespace-"
263      :group 'whitespace
264      :group 'faces)
265    
266    (defface whitespace-highlight-face '((((class color) (background light))
267                                        (:background "green"))
268                                       (((class color) (background dark))
269                                        (:background "sea green"))
270                                       (((class grayscale monochrome)
271                                         (background light))
272                                        (:background "black"))
273                                       (((class grayscale monochrome)
274                                         (background dark))
275                                        (:background "white")))
276      "Face used for highlighting the bogus whitespaces that exist in the buffer."
277      :group 'whitespace-faces)
278    
279  (if (not (assoc 'whitespace-mode minor-mode-alist))  (if (not (assoc 'whitespace-mode minor-mode-alist))
280      (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)      (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
281                                   minor-mode-alist)))                                   minor-mode-alist)))
# Line 329  and: Line 375  and:
375          (progn          (progn
376            (whitespace-check-buffer-list (buffer-name) buffer-file-name)            (whitespace-check-buffer-list (buffer-name) buffer-file-name)
377            (whitespace-tickle-timer)            (whitespace-tickle-timer)
378              (whitespace-unhighlight-the-space)
379            (if whitespace-auto-cleanup            (if whitespace-auto-cleanup
380                (if buffer-read-only                (if buffer-read-only
381                    (if (not quiet)                    (if (not quiet)
# Line 498  whitespace problems." Line 545  whitespace problems."
545        (end-of-line)        (end-of-line)
546        (setq pmax (point))        (setq pmax (point))
547        (if (equal pmin pmax)        (if (equal pmin pmax)
548            t            (progn
549                (whitespace-highlight-the-space pmin pmax)
550                t)
551          nil))))          nil))))
552    
553  (defun whitespace-buffer-leading-cleanup ()  (defun whitespace-buffer-leading-cleanup ()
# Line 534  whitespace problems." Line 583  whitespace problems."
583              (end-of-line)              (end-of-line)
584              (setq pmax (point))              (setq pmax (point))
585              (if (equal pmin pmax)              (if (equal pmin pmax)
586                  t                  (progn
587                      (whitespace-highlight-the-space pmin pmax)
588                      t)
589                nil))                nil))
590          nil))))          nil))))
591    
# Line 568  whitespace problems." Line 619  whitespace problems."
619      (save-excursion      (save-excursion
620        (goto-char (point-min))        (goto-char (point-min))
621        (while (re-search-forward regexp nil t)        (while (re-search-forward regexp nil t)
622          (setq whitespace-retval (format "%s %s" whitespace-retval          (progn
623                                          (match-beginning 0))))            (setq whitespace-retval (format "%s %s" whitespace-retval
624                                            (match-beginning 0)))
625            (whitespace-highlight-the-space (match-beginning 0) (match-end 0))))
626        (if (equal "" whitespace-retval)        (if (equal "" whitespace-retval)
627            nil            nil
628          whitespace-retval))))          whitespace-retval))))
# Line 621  Also with whitespaces whose testing has Line 674  Also with whitespaces whose testing has
674          (setq whitespace-mode-line (if whitespace-mode-line          (setq whitespace-mode-line (if whitespace-mode-line
675                                         (concat " W:" whitespace-mode-line)                                         (concat " W:" whitespace-mode-line)
676                                       nil))                                       nil))
677          (whitespace-force-mode-line-update))))          (whitespace-mode-line-update))))
678    
679  ;; Force mode line updation for different Emacs versions  (defun whitespace-highlight-the-space (b e)
680  (defun whitespace-force-mode-line-update ()    "Highlight the current line, unhighlighting a previously jumped to line."
681    "Force the mode line update for different flavors of Emacs."    (if whitespace-display-spaces-in-color
682    (if (fboundp 'redraw-modeline)        (progn
683        (redraw-modeline)                 ; XEmacs          (whitespace-unhighlight-the-space)
684      (force-mode-line-update)))          ; Emacs          (add-to-list 'whitespace-highlighted-space
685                         (whitespace-make-overlay b e))
686            (whitespace-overlay-put (whitespace-make-overlay b e) 'face
687                                    'whitespace-highlight-face))))
688    ;;  (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space))
689    
690    (defun whitespace-unhighlight-the-space ()
691      "Unhighlight the currently highlight line."
692      (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
693          (let ((whitespace-this-space nil))
694            (while whitespace-highlighted-space
695              (setq whitespace-this-space (car whitespace-highlighted-space))
696              (setq whitespace-highlighted-space
697                    (cdr whitespace-highlighted-space))
698              (whitespace-delete-overlay whitespace-this-space))
699            (setq whitespace-highlighted-space nil))
700        (remove-hook 'pre-command-hook 'whitespace-unhighlight-the-space)))
701    
702  (defun whitespace-check-buffer-list (buf-name buf-file)  (defun whitespace-check-buffer-list (buf-name buf-file)
703    "Add a buffer and its file to the whitespace monitor list.    "Add a buffer and its file to the whitespace monitor list.
# Line 803  whitespaces during the process of your e Line 872  whitespaces during the process of your e
872    (remove-hook 'kill-buffer-hook 'whitespace-buffer))    (remove-hook 'kill-buffer-hook 'whitespace-buffer))
873    
874  (provide 'whitespace)  (provide 'whitespace)
   
875  ;;; whitespace.el ends here  ;;; whitespace.el ends here

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26