comparison lisp/whitespace.el @ 105190:a0ecdf08bbf5

New version 12. Bug#4177
author Vinicius Jose Latorre <viniciusjl@ig.com.br>
date Fri, 25 Sep 2009 02:23:51 +0000
parents 316b10a4c19e
children 1308a0fb85e9
comparison
equal deleted inserted replaced
105189:7669aca277d5 105190:a0ecdf08bbf5
4 ;; Free Software Foundation, Inc. 4 ;; Free Software Foundation, Inc.
5 5
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> 7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Keywords: data, wp 8 ;; Keywords: data, wp
9 ;; Version: 11.2.2 9 ;; Version: 12
10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre 10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
11 11
12 ;; This file is part of GNU Emacs. 12 ;; This file is part of GNU Emacs.
13 13
14 ;; GNU Emacs is free software: you can redistribute it and/or modify 14 ;; GNU Emacs is free software: you can redistribute it and/or modify
868 868
869 869
870 ;; Hacked from `visible-whitespace-mappings' in visws.el 870 ;; Hacked from `visible-whitespace-mappings' in visws.el
871 (defcustom whitespace-display-mappings 871 (defcustom whitespace-display-mappings
872 '( 872 '(
873 (space-mark ?\ [?\xB7] [?.]) ; space - centered dot 873 (space-mark ?\ [?\u00B7] [?.]) ; space - centered dot
874 (space-mark ?\xA0 [?\xA4] [?_]) ; hard space - currency 874 (space-mark ?\xA0 [?\u00A4] [?_]) ; hard space - currency
875 (space-mark ?\x8A0 [?\x8A4] [?_]) ; hard space - currency 875 (space-mark ?\x8A0 [?\x8A4] [?_]) ; hard space - currency
876 (space-mark ?\x920 [?\x924] [?_]) ; hard space - currency 876 (space-mark ?\x920 [?\x924] [?_]) ; hard space - currency
877 (space-mark ?\xE20 [?\xE24] [?_]) ; hard space - currency 877 (space-mark ?\xE20 [?\xE24] [?_]) ; hard space - currency
878 (space-mark ?\xF20 [?\xF24] [?_]) ; hard space - currency 878 (space-mark ?\xF20 [?\xF24] [?_]) ; hard space - currency
879 ;; NEWLINE is displayed using the face `whitespace-newline' 879 ;; NEWLINE is displayed using the face `whitespace-newline'
880 (newline-mark ?\n [?$ ?\n]) ; eol - dollar sign 880 (newline-mark ?\n [?$ ?\n]) ; eol - dollar sign
881 ;; (newline-mark ?\n [?\u21B5 ?\n] [?$ ?\n]) ; eol - downwards arrow 881 ;; (newline-mark ?\n [?\u21B5 ?\n] [?$ ?\n]) ; eol - downwards arrow
882 ;; (newline-mark ?\n [?\xB6 ?\n] [?$ ?\n]) ; eol - pilcrow 882 ;; (newline-mark ?\n [?\u00B6 ?\n] [?$ ?\n]) ; eol - pilcrow
883 ;; (newline-mark ?\n [?\x8AF ?\n] [?$ ?\n]) ; eol - overscore 883 ;; (newline-mark ?\n [?\x8AF ?\n] [?$ ?\n]) ; eol - overscore
884 ;; (newline-mark ?\n [?\x8AC ?\n] [?$ ?\n]) ; eol - negation 884 ;; (newline-mark ?\n [?\x8AC ?\n] [?$ ?\n]) ; eol - negation
885 ;; (newline-mark ?\n [?\x8B0 ?\n] [?$ ?\n]) ; eol - grade 885 ;; (newline-mark ?\n [?\x8B0 ?\n] [?$ ?\n]) ; eol - grade
886 ;; 886 ;;
887 ;; WARNING: the mapping below has a problem. 887 ;; WARNING: the mapping below has a problem.
888 ;; When a TAB occupies exactly one column, it will display the 888 ;; When a TAB occupies exactly one column, it will display the
889 ;; character ?\xBB at that column followed by a TAB which goes to 889 ;; character ?\xBB at that column followed by a TAB which goes to
890 ;; the next TAB column. 890 ;; the next TAB column.
891 ;; If this is a problem for you, please, comment the line below. 891 ;; If this is a problem for you, please, comment the line below.
892 (tab-mark ?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark 892 (tab-mark ?\t [?\u00BB ?\t] [?\\ ?\t]) ; tab - left quote mark
893 ) 893 )
894 "Specify an alist of mappings for displaying characters. 894 "Specify an alist of mappings for displaying characters.
895 895
896 Each element has the following form: 896 Each element has the following form:
897 897
1217 (defvar whitespace-indent-tabs-mode indent-tabs-mode 1217 (defvar whitespace-indent-tabs-mode indent-tabs-mode
1218 "Used to save locally `indent-tabs-mode' value.") 1218 "Used to save locally `indent-tabs-mode' value.")
1219 1219
1220 (defvar whitespace-tab-width tab-width 1220 (defvar whitespace-tab-width tab-width
1221 "Used to save locally `tab-width' value.") 1221 "Used to save locally `tab-width' value.")
1222
1223 (defvar whitespace-point (point)
1224 "Used to save locally current point value.
1225 Used by `whitespace-trailing-regexp' function (which see).")
1226
1227 (defvar whitespace-font-lock-refontify nil
1228 "Used to save locally the font-lock refontify state.
1229 Used by `whitespace-post-command-hook' function (which see).")
1222 1230
1223 1231
1224 ;;;###autoload 1232 ;;;###autoload
1225 (defun whitespace-toggle-options (arg) 1233 (defun whitespace-toggle-options (arg)
1226 "Toggle local `whitespace-mode' options. 1234 "Toggle local `whitespace-mode' options.
2137 (when (whitespace-style-face-p) 2145 (when (whitespace-style-face-p)
2138 (unless whitespace-font-lock 2146 (unless whitespace-font-lock
2139 (setq whitespace-font-lock t 2147 (setq whitespace-font-lock t
2140 whitespace-font-lock-keywords 2148 whitespace-font-lock-keywords
2141 (copy-sequence font-lock-keywords))) 2149 (copy-sequence font-lock-keywords)))
2150 ;; save current point and refontify when necessary
2151 (set (make-local-variable 'whitespace-point)
2152 (point))
2153 (set (make-local-variable 'whitespace-font-lock-refontify)
2154 nil)
2155 (add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
2142 ;; turn off font lock 2156 ;; turn off font lock
2143 (set (make-local-variable 'whitespace-font-lock-mode) 2157 (set (make-local-variable 'whitespace-font-lock-mode)
2144 font-lock-mode) 2158 font-lock-mode)
2145 (font-lock-mode 0) 2159 (font-lock-mode 0)
2146 ;; add whitespace-mode color into font lock 2160 ;; add whitespace-mode color into font lock
2147 (when (memq 'spaces whitespace-active-style) 2161 (when (memq 'spaces whitespace-active-style)
2148 (font-lock-add-keywords 2162 (font-lock-add-keywords
2149 nil 2163 nil
2150 (list 2164 (list
2151 ;; Show SPACEs 2165 ;; Show SPACEs
2152 (list whitespace-space-regexp 1 whitespace-space t) 2166 (list #'whitespace-space-regexp 1 whitespace-space t)
2153 ;; Show HARD SPACEs 2167 ;; Show HARD SPACEs
2154 (list whitespace-hspace-regexp 1 whitespace-hspace t)) 2168 (list whitespace-hspace-regexp 1 whitespace-hspace t))
2155 t)) 2169 t))
2156 (when (memq 'tabs whitespace-active-style) 2170 (when (memq 'tabs whitespace-active-style)
2157 (font-lock-add-keywords 2171 (font-lock-add-keywords
2158 nil 2172 nil
2159 (list 2173 (list
2160 ;; Show TABs 2174 ;; Show TABs
2161 (list whitespace-tab-regexp 1 whitespace-tab t)) 2175 (list #'whitespace-tab-regexp 1 whitespace-tab t))
2162 t)) 2176 t))
2163 (when (memq 'trailing whitespace-active-style) 2177 (when (memq 'trailing whitespace-active-style)
2164 (font-lock-add-keywords 2178 (font-lock-add-keywords
2165 nil 2179 nil
2166 (list 2180 (list
2167 ;; Show trailing blanks 2181 ;; Show trailing blanks
2168 (list whitespace-trailing-regexp 1 whitespace-trailing t)) 2182 (list #'whitespace-trailing-regexp 1 whitespace-trailing t))
2169 t)) 2183 t))
2170 (when (or (memq 'lines whitespace-active-style) 2184 (when (or (memq 'lines whitespace-active-style)
2171 (memq 'lines-tail whitespace-active-style)) 2185 (memq 'lines-tail whitespace-active-style))
2172 (font-lock-add-keywords 2186 (font-lock-add-keywords
2173 nil 2187 nil
2175 ;; Show "long" lines 2189 ;; Show "long" lines
2176 (list 2190 (list
2177 (format 2191 (format
2178 "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" 2192 "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
2179 whitespace-tab-width (1- whitespace-tab-width) 2193 whitespace-tab-width (1- whitespace-tab-width)
2180 (/ whitespace-line-column tab-width) 2194 (/ whitespace-line-column whitespace-tab-width)
2181 (let ((rem (% whitespace-line-column whitespace-tab-width))) 2195 (let ((rem (% whitespace-line-column whitespace-tab-width)))
2182 (if (zerop rem) 2196 (if (zerop rem)
2183 "" 2197 ""
2184 (format ".\\{%d\\}" rem)))) 2198 (format ".\\{%d\\}" rem))))
2185 (if (memq 'lines whitespace-active-style) 2199 (if (memq 'lines whitespace-active-style)
2241 (when (memq 'empty whitespace-active-style) 2255 (when (memq 'empty whitespace-active-style)
2242 (font-lock-add-keywords 2256 (font-lock-add-keywords
2243 nil 2257 nil
2244 (list 2258 (list
2245 ;; Show empty lines at beginning of buffer 2259 ;; Show empty lines at beginning of buffer
2246 (list whitespace-empty-at-bob-regexp 2260 (list #'whitespace-empty-at-bob-regexp
2247 1 whitespace-empty t)) 2261 1 whitespace-empty t))
2248 t) 2262 t)
2249 (font-lock-add-keywords 2263 (font-lock-add-keywords
2250 nil 2264 nil
2251 (list 2265 (list
2252 ;; Show empty lines at end of buffer 2266 ;; Show empty lines at end of buffer
2253 (list whitespace-empty-at-eob-regexp 2267 (list #'whitespace-empty-at-eob-regexp
2254 1 whitespace-empty t)) 2268 1 whitespace-empty t))
2255 t)) 2269 t))
2256 (cond 2270 (cond
2257 ((memq 'space-after-tab whitespace-active-style) 2271 ((memq 'space-after-tab whitespace-active-style)
2258 (font-lock-add-keywords 2272 (font-lock-add-keywords
2285 (defun whitespace-color-off () 2299 (defun whitespace-color-off ()
2286 "Turn off color visualization." 2300 "Turn off color visualization."
2287 ;; turn off font lock 2301 ;; turn off font lock
2288 (when (whitespace-style-face-p) 2302 (when (whitespace-style-face-p)
2289 (font-lock-mode 0) 2303 (font-lock-mode 0)
2304 (remove-hook 'post-command-hook #'whitespace-post-command-hook)
2290 (when whitespace-font-lock 2305 (when whitespace-font-lock
2291 (setq whitespace-font-lock nil 2306 (setq whitespace-font-lock nil
2292 font-lock-keywords whitespace-font-lock-keywords)) 2307 font-lock-keywords whitespace-font-lock-keywords))
2293 ;; restore original font lock state 2308 ;; restore original font lock state
2294 (font-lock-mode whitespace-font-lock-mode))) 2309 (font-lock-mode whitespace-font-lock-mode)))
2310
2311
2312 (defun whitespace-trailing-regexp (limit)
2313 "Match trailing spaces which does not contain the point at end of line."
2314 (let ((status t))
2315 (while (if (re-search-forward whitespace-trailing-regexp limit t)
2316 (save-match-data
2317 (= whitespace-point (match-end 1))) ;; loop if point at eol
2318 (setq status nil))) ;; end of buffer
2319 status))
2320
2321
2322 (defun whitespace-empty-at-bob-regexp (limit)
2323 "Match spaces at beginning of buffer which does not contain the point at \
2324 beginning of buffer."
2325 (and (/= whitespace-point 1)
2326 (re-search-forward whitespace-empty-at-bob-regexp limit t)))
2327
2328
2329 (defun whitespace-empty-at-eob-regexp (limit)
2330 "Match spaces at end of buffer which does not contain the point at end of \
2331 buffer."
2332 (and (/= whitespace-point (1+ (buffer-size)))
2333 (re-search-forward whitespace-empty-at-eob-regexp limit t)))
2334
2335
2336 (defun whitespace-space-regexp (limit)
2337 "Match spaces."
2338 (setq whitespace-font-lock-refontify t)
2339 (re-search-forward whitespace-space-regexp limit t))
2340
2341
2342 (defun whitespace-tab-regexp (limit)
2343 "Match tabs."
2344 (setq whitespace-font-lock-refontify t)
2345 (re-search-forward whitespace-tab-regexp limit t))
2346
2347
2348 (defun whitespace-post-command-hook ()
2349 "Save current point into `whitespace-point' variable.
2350 Also refontify when necessary."
2351 (setq whitespace-point (point))
2352 (let ((refontify (or (eolp) ; end of line
2353 (= whitespace-point 1)))) ; beginning of buffer
2354 (when (or whitespace-font-lock-refontify refontify)
2355 (setq whitespace-font-lock-refontify refontify)
2356 (jit-lock-refontify))))
2295 2357
2296 2358
2297 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2359 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2298 ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) 2360 ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
2299 2361