comparison lisp/whitespace.el @ 110234:28ca316fcaea

Merge whitespace.el from trunk

110233:9b0c446f8952

;;   Free Software Foundation, Inc.

;; Author: Vinicius Jose Latorre <[e-mail]>
;; Maintainer: Vinicius Jose Latorre <[e-mail]>
;; Keywords: data, wp
;; Version: 13.0
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify

(defgroup whitespace nil
  "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
  :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el")
  :version "23.1"
  :group 'wp
  :group 'data)


(defcustom whitespace-style
  '(tabs spaces trailing lines space-before-tab newline
	 indentation empty space-after-tab
	 space-mark tab-mark newline-mark)
  "Specify which kind of blank is visualized.

It's a list containing some or all of the following values:

   trailing		trailing blanks are visualized via faces.

   tabs			TABs are visualized via faces.

   spaces		SPACEs and HARD SPACEs are visualized via
			faces.

   lines		lines which have columns beyond
			`whitespace-line-column' are highlighted via
			faces.
			Whole line is highlighted.
			It has precedence over `lines-tail' (see
			below).

   lines-tail		lines which have columns beyond
			`whitespace-line-column' are highlighted via
			faces.
			But only the part of line which goes
			beyond `whitespace-line-column' column.
			It has effect only if `lines' (see above)
			is not present in `whitespace-style'.

   newline		NEWLINEs are visualized via faces.

   empty		empty lines at beginning and/or end of buffer
			are visualized via faces.

   indentation::tab	8 or more SPACEs at beginning of line are
			visualized via faces.

   indentation::space	TABs at beginning of line are visualized via
			faces.

   indentation		8 or more SPACEs at beginning of line are
			visualized, if `indent-tabs-mode' (which see)
			is non-nil; otherwise, TABs at beginning of
			line are visualized via faces.

   space-after-tab::tab		8 or more SPACEs after a TAB are
				visualized via faces.

   space-after-tab::space	TABs are visualized when 8 or more
				SPACEs occur after a TAB, via faces.

   space-after-tab		8 or more SPACEs after a TAB are
				visualized, if `indent-tabs-mode'
				(which see) is non-nil; otherwise,
				the TABs are visualized via faces.

   space-before-tab::tab	SPACEs before TAB are visualized via
				faces.

   space-before-tab::space	TABs are visualized when SPACEs occur
				before TAB, via faces.

   space-before-tab		SPACEs before TAB are visualized, if
				`indent-tabs-mode' (which see) is
				non-nil; otherwise, the TABs are
				visualized via faces.

   space-mark		SPACEs and HARD SPACEs are visualized via
			display table.

   tab-mark		TABs are visualized via display table.

So, for example, if indentation and indentation::space are
included in `whitespace-style' list, the indentation value is
evaluated instead of indentation::space value.

See also `whitespace-display-mappings' for documentation."
  :type '(repeat :tag "Kind of Blank"
		 (choice :tag "Kind of Blank Face"
			 (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
				trailing)
			 (const :tag "(Face) SPACEs and HARD SPACEs"
				spaces)
			 (const :tag "(Face) TABs" tabs)

  :group 'whitespace)


(defface whitespace-space
  '((((class color) (background dark))
     (:background "grey20"      :foreground "aquamarine3"))
    (((class color) (background light))
     (:background "LightYellow" :foreground "aquamarine3"))
    (t (:inverse-video t)))
  "Face used to visualize SPACE."
  :group 'whitespace)

  :group 'whitespace)


(defface whitespace-hspace		; 'nobreak-space
  '((((class color) (background dark))
     (:background "grey24"        :foreground "aquamarine3"))
    (((class color) (background light))
     (:background "LemonChiffon3" :foreground "aquamarine3"))
    (t (:inverse-video t)))
  "Face used to visualize HARD SPACE."
  :group 'whitespace)

  :group 'whitespace)


(defface whitespace-tab
  '((((class color) (background dark))
     (:background "grey22" :foreground "aquamarine3"))
    (((class color) (background light))
     (:background "beige"  :foreground "aquamarine3"))
    (t (:inverse-video t)))
  "Face used to visualize TAB."
  :group 'whitespace)

(defcustom whitespace-line-column 80
  "Specify column beyond which the line is highlighted.

Used when `whitespace-style' includes `lines' or `lines-tail'."
  :type '(integer :tag "Line Length")
  :group 'whitespace)


;; Hacked from `visible-whitespace-mappings' in visws.el
(defcustom whitespace-display-mappings

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; User commands - Toggle


(defconst whitespace-style-value-list
  '(tabs
    spaces
    trailing
    lines
    lines-tail
    newline

    )
  "List of valid `whitespace-style' values.")


(defconst whitespace-toggle-option-alist
  '((?t    . tabs)
    (?s    . spaces)
    (?r    . trailing)
    (?l    . lines)
    (?L    . lines-tail)
    (?n    . newline)

Interactively, it reads one of the following chars:

  CHAR	MEANING
  (VIA FACES)
   t	toggle TAB visualization
   s	toggle SPACE and HARD SPACE visualization
   r	toggle trailing blanks visualization
   l	toggle \"long lines\" visualization
   L	toggle \"long lines\" tail visualization

   ?	display brief help

Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:

   tabs			toggle TAB visualization
   spaces		toggle SPACE and HARD SPACE visualization
   trailing		toggle trailing blanks visualization
   lines		toggle \"long lines\" visualization
   lines-tail		toggle \"long lines\" tail visualization

Interactively, it accepts one of the following chars:

  CHAR	MEANING
  (VIA FACES)
   t	toggle TAB visualization
   s	toggle SPACE and HARD SPACE visualization
   r	toggle trailing blanks visualization
   l	toggle \"long lines\" visualization
   L	toggle \"long lines\" tail visualization

   ?	display brief help

Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:

   tabs			toggle TAB visualization
   spaces		toggle SPACE and HARD SPACE visualization
   trailing		toggle trailing blanks visualization
   lines		toggle \"long lines\" visualization
   lines-tail		toggle \"long lines\" tail visualization

  "Used to save locally `font-lock-keywords' value.")


(defconst whitespace-help-text
  "\
 Whitespace Toggle Options

 FACES
 []  t   - toggle TAB visualization
 []  s   - toggle SPACE and HARD SPACE visualization
 []  r   - toggle trailing blanks visualization
 []  l   - toggle \"long lines\" visualization
 []  L   - toggle \"long lines\" tail visualization

(defun whitespace-display-window (buffer)
  "Display BUFFER in a new window."
  (goto-char (point-min))
  (set-buffer-modified-p nil)
  (let ((size (- (window-height)
		 (max window-min-height
		      (1+ (count-lines (point-min)
				       (point-max)))))))
    (when (<= size 0)
      (kill-buffer buffer)
      (error "Frame height is too small; \
can't split window to display whitespace toggle options"))
    (set-window-buffer (split-window nil size) buffer)))


(defun whitespace-kill-buffer (buffer-name)
  "Kill buffer BUFFER-NAME and windows related with it."
  (let ((buffer (get-buffer buffer-name)))

(defun whitespace-help-off ()
  "Remove the buffer and window of the whitespace toggle options."
  (whitespace-kill-buffer whitespace-help-buffer-name))


(defun whitespace-interactive-char (local-p)
  "Interactive function to read a char and return a symbol.

If LOCAL-P is non-nil, it uses a local context; otherwise, it
uses a global context.

It accepts one of the following chars:

  CHAR	MEANING
  (VIA FACES)
   t	toggle TAB visualization
   s	toggle SPACE and HARD SPACE visualization
   r	toggle trailing blanks visualization
   l	toggle \"long lines\" visualization
   L	toggle \"long lines\" tail visualization

		  (not
		   (setq sym
			 (cdr
			  (assq ch whitespace-toggle-option-alist)))))
	      ;; while body
	      (if (eq ch ?\?)
		  (whitespace-help-on style)
		(ding)))
	    (whitespace-help-off)
	    (message " "))		; clean echo area
	;; handler
	((quit error)
	 (whitespace-help-off)

    (whitespace-display-char-off)))


(defun whitespace-style-face-p ()
  "Return t if there is some visualization via face."
  (or (memq 'tabs                    whitespace-active-style)
      (memq 'spaces                  whitespace-active-style)
      (memq 'trailing                whitespace-active-style)
      (memq 'lines                   whitespace-active-style)
      (memq 'lines-tail              whitespace-active-style)
      (memq 'newline                 whitespace-active-style)
      (memq 'empty                   whitespace-active-style)
      (memq 'indentation             whitespace-active-style)
      (memq 'indentation::tab        whitespace-active-style)
      (memq 'indentation::space      whitespace-active-style)
      (memq 'space-after-tab         whitespace-active-style)
      (memq 'space-after-tab::tab    whitespace-active-style)
      (memq 'space-after-tab::space  whitespace-active-style)
      (memq 'space-before-tab        whitespace-active-style)
      (memq 'space-before-tab::tab   whitespace-active-style)
      (memq 'space-before-tab::space whitespace-active-style)))


(defun whitespace-color-on ()
  "Turn on color visualization."
  (when (whitespace-style-face-p)

      (font-lock-add-keywords
       nil
       (list
	;; Show "long" lines
	(list
	 (format
	  "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
	  whitespace-tab-width (1- whitespace-tab-width)
	  (/ whitespace-line-column whitespace-tab-width)
	  (let ((rem (% whitespace-line-column whitespace-tab-width)))
	    (if (zerop rem)
		""
	      (format ".\\{%d\\}" rem))))
	 (if (memq 'lines whitespace-active-style)
	     0				; whole line
	   2)				; line tail
	 whitespace-line t))
       t))

110234:28ca316fcaea

;;   Free Software Foundation, Inc.

;; Author: Vinicius Jose Latorre <[e-mail]>
;; Maintainer: Vinicius Jose Latorre <[e-mail]>
;; Keywords: data, wp
;; Version: 13.1
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify

(defgroup whitespace nil
  "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
  :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el")
  :version "23.1"
  :group 'convenience)


(defcustom whitespace-style
  '(face
    tabs spaces trailing lines space-before-tab newline
    indentation empty space-after-tab
    space-mark tab-mark newline-mark)
  "Specify which kind of blank is visualized.

It's a list containing some or all of the following values:

   face			enable all visualization via faces (see below).

   trailing		trailing blanks are visualized via faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   tabs			TABs are visualized via faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   spaces		SPACEs and HARD SPACEs are visualized via
			faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   lines		lines which have columns beyond
			`whitespace-line-column' are highlighted via
			faces.
			Whole line is highlighted.
			It has precedence over `lines-tail' (see
			below).
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   lines-tail		lines which have columns beyond
			`whitespace-line-column' are highlighted via
			faces.
			But only the part of line which goes
			beyond `whitespace-line-column' column.
			It has effect only if `lines' (see above)
			is not present in `whitespace-style'
			and if `face' (see above) is present in
			`whitespace-style'.

   newline		NEWLINEs are visualized via faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   empty		empty lines at beginning and/or end of buffer
			are visualized via faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   indentation::tab	8 or more SPACEs at beginning of line are
			visualized via faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   indentation::space	TABs at beginning of line are visualized via
			faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   indentation		8 or more SPACEs at beginning of line are
			visualized, if `indent-tabs-mode' (which see)
			is non-nil; otherwise, TABs at beginning of
			line are visualized via faces.
			It has effect only if `face' (see above)
			is present in `whitespace-style'.

   space-after-tab::tab		8 or more SPACEs after a TAB are
				visualized via faces.
				It has effect only if `face' (see above)
				is present in `whitespace-style'.

   space-after-tab::space	TABs are visualized when 8 or more
				SPACEs occur after a TAB, via faces.
				It has effect only if `face' (see above)
				is present in `whitespace-style'.

   space-after-tab		8 or more SPACEs after a TAB are
				visualized, if `indent-tabs-mode'
				(which see) is non-nil; otherwise,
				the TABs are visualized via faces.
				It has effect only if `face' (see above)
				is present in `whitespace-style'.

   space-before-tab::tab	SPACEs before TAB are visualized via
				faces.
				It has effect only if `face' (see above)
				is present in `whitespace-style'.

   space-before-tab::space	TABs are visualized when SPACEs occur
				before TAB, via faces.
				It has effect only if `face' (see above)
				is present in `whitespace-style'.

   space-before-tab		SPACEs before TAB are visualized, if
				`indent-tabs-mode' (which see) is
				non-nil; otherwise, the TABs are
				visualized via faces.
				It has effect only if `face' (see above)
				is present in `whitespace-style'.

   space-mark		SPACEs and HARD SPACEs are visualized via
			display table.

   tab-mark		TABs are visualized via display table.

So, for example, if indentation and indentation::space are
included in `whitespace-style' list, the indentation value is
evaluated instead of indentation::space value.

One reason for not visualize spaces via faces (if `face' is not
included in `whitespace-style') is to use exclusively for
cleanning up a buffer.  See `whitespace-cleanup' and
`whitespace-cleanup-region' for documentation.

See also `whitespace-display-mappings' for documentation."
  :type '(repeat :tag "Kind of Blank"
		 (choice :tag "Kind of Blank Face"
			 (const :tag "(Face) Face visualization"
				face)
			 (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
				trailing)
			 (const :tag "(Face) SPACEs and HARD SPACEs"
				spaces)
			 (const :tag "(Face) TABs" tabs)

  :group 'whitespace)


(defface whitespace-space
  '((((class color) (background dark))
     (:background "grey20"      :foreground "darkgray"))
    (((class color) (background light))
     (:background "LightYellow" :foreground "lightgray"))
    (t (:inverse-video t)))
  "Face used to visualize SPACE."
  :group 'whitespace)

  :group 'whitespace)


(defface whitespace-hspace		; 'nobreak-space
  '((((class color) (background dark))
     (:background "grey24"        :foreground "darkgray"))
    (((class color) (background light))
     (:background "LemonChiffon3" :foreground "lightgray"))
    (t (:inverse-video t)))
  "Face used to visualize HARD SPACE."
  :group 'whitespace)

  :group 'whitespace)


(defface whitespace-tab
  '((((class color) (background dark))
     (:background "grey22" :foreground "darkgray"))
    (((class color) (background light))
     (:background "beige"  :foreground "lightgray"))
    (t (:inverse-video t)))
  "Face used to visualize TAB."
  :group 'whitespace)

(defcustom whitespace-line-column 80
  "Specify column beyond which the line is highlighted.

It must be an integer or nil.  If nil, the `fill-column' variable value is
used.

Used when `whitespace-style' includes `lines' or `lines-tail'."
  :type '(choice :tag "Line Length Limit"
		 (integer :tag "Line Length")
		 (const :tag "Use fill-column" nil))
  :group 'whitespace)


;; Hacked from `visible-whitespace-mappings' in visws.el
(defcustom whitespace-display-mappings

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; User commands - Toggle


(defconst whitespace-style-value-list
  '(face
    tabs
    spaces
    trailing
    lines
    lines-tail
    newline

    )
  "List of valid `whitespace-style' values.")


(defconst whitespace-toggle-option-alist
  '((?f    . face)
    (?t    . tabs)
    (?s    . spaces)
    (?r    . trailing)
    (?l    . lines)
    (?L    . lines-tail)
    (?n    . newline)

Interactively, it reads one of the following chars:

  CHAR	MEANING
  (VIA FACES)
   f	toggle face visualization
   t	toggle TAB visualization
   s	toggle SPACE and HARD SPACE visualization
   r	toggle trailing blanks visualization
   l	toggle \"long lines\" visualization
   L	toggle \"long lines\" tail visualization

   ?	display brief help

Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:

   face			toggle face visualization
   tabs			toggle TAB visualization
   spaces		toggle SPACE and HARD SPACE visualization
   trailing		toggle trailing blanks visualization
   lines		toggle \"long lines\" visualization
   lines-tail		toggle \"long lines\" tail visualization

Interactively, it accepts one of the following chars:

  CHAR	MEANING
  (VIA FACES)
   f	toggle face visualization
   t	toggle TAB visualization
   s	toggle SPACE and HARD SPACE visualization
   r	toggle trailing blanks visualization
   l	toggle \"long lines\" visualization
   L	toggle \"long lines\" tail visualization

   ?	display brief help

Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:

   face			toggle face visualization
   tabs			toggle TAB visualization
   spaces		toggle SPACE and HARD SPACE visualization
   trailing		toggle trailing blanks visualization
   lines		toggle \"long lines\" visualization
   lines-tail		toggle \"long lines\" tail visualization

  "Used to save locally `font-lock-keywords' value.")


(defconst whitespace-help-text
  "\
 Whitespace Toggle Options                  | scroll up  :  SPC   or > |
                                            | scroll down:  M-SPC or < |
 FACES                                      \\__________________________/
 []  f   - toggle face visualization
 []  t   - toggle TAB visualization
 []  s   - toggle SPACE and HARD SPACE visualization
 []  r   - toggle trailing blanks visualization
 []  l   - toggle \"long lines\" visualization
 []  L   - toggle \"long lines\" tail visualization

(defun whitespace-display-window (buffer)
  "Display BUFFER in a new window."
  (goto-char (point-min))
  (set-buffer-modified-p nil)
  (when (< (window-height) (* 2 window-min-height))
    (kill-buffer buffer)
    (error "Window height is too small; \
can't split window to display whitespace toggle options"))
  (let ((win (split-window)))
    (set-window-buffer win buffer)
    (shrink-window-if-larger-than-buffer win)))


(defun whitespace-kill-buffer (buffer-name)
  "Kill buffer BUFFER-NAME and windows related with it."
  (let ((buffer (get-buffer buffer-name)))

(defun whitespace-help-off ()
  "Remove the buffer and window of the whitespace toggle options."
  (whitespace-kill-buffer whitespace-help-buffer-name))


(defun whitespace-help-scroll (&optional up)
  "Scroll help window, if it exists.

If UP is non-nil, scroll up; otherwise, scroll down."
  (condition-case data-help
      (let ((buffer (get-buffer whitespace-help-buffer-name)))
	(if buffer
	    (with-selected-window (get-buffer-window buffer)
	      (if up
		  (scroll-up 3)
		(scroll-down 3)))
	  (ding)))
    ;; handler
    ((error)
     ;; just ignore error
     )))


(defun whitespace-interactive-char (local-p)
  "Interactive function to read a char and return a symbol.

If LOCAL-P is non-nil, it uses a local context; otherwise, it
uses a global context.

It accepts one of the following chars:

  CHAR	MEANING
  (VIA FACES)
   f	toggle face visualization
   t	toggle TAB visualization
   s	toggle SPACE and HARD SPACE visualization
   r	toggle trailing blanks visualization
   l	toggle \"long lines\" visualization
   L	toggle \"long lines\" tail visualization

		  (not
		   (setq sym
			 (cdr
			  (assq ch whitespace-toggle-option-alist)))))
	      ;; while body
	      (cond
	       ((eq ch ?\?)   (whitespace-help-on style))
	       ((eq ch ?\ )   (whitespace-help-scroll t))
	       ((eq ch ?\M- ) (whitespace-help-scroll))
	       ((eq ch ?>)    (whitespace-help-scroll t))
	       ((eq ch ?<)    (whitespace-help-scroll))
	       (t             (ding))))
	    (whitespace-help-off)
	    (message " "))		; clean echo area
	;; handler
	((quit error)
	 (whitespace-help-off)

    (whitespace-display-char-off)))


(defun whitespace-style-face-p ()
  "Return t if there is some visualization via face."
  (and (memq 'face whitespace-active-style)
       (or (memq 'tabs                    whitespace-active-style)
	   (memq 'spaces                  whitespace-active-style)
	   (memq 'trailing                whitespace-active-style)
	   (memq 'lines                   whitespace-active-style)
	   (memq 'lines-tail              whitespace-active-style)
	   (memq 'newline                 whitespace-active-style)
	   (memq 'empty                   whitespace-active-style)
	   (memq 'indentation             whitespace-active-style)
	   (memq 'indentation::tab        whitespace-active-style)
	   (memq 'indentation::space      whitespace-active-style)
	   (memq 'space-after-tab         whitespace-active-style)
	   (memq 'space-after-tab::tab    whitespace-active-style)
	   (memq 'space-after-tab::space  whitespace-active-style)
	   (memq 'space-before-tab        whitespace-active-style)
	   (memq 'space-before-tab::tab   whitespace-active-style)
	   (memq 'space-before-tab::space whitespace-active-style))))


(defun whitespace-color-on ()
  "Turn on color visualization."
  (when (whitespace-style-face-p)

      (font-lock-add-keywords
       nil
       (list
	;; Show "long" lines
	(list
	 (let ((line-column (or whitespace-line-column fill-column)))
	   (format
	    "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
	    whitespace-tab-width
	    (1- whitespace-tab-width)
	    (/ line-column whitespace-tab-width)
	    (let ((rem (% line-column whitespace-tab-width)))
	      (if (zerop rem)
		  ""
		(format ".\\{%d\\}" rem)))))
	 (if (memq 'lines whitespace-active-style)
	     0				; whole line
	   2)				; line tail
	 whitespace-line t))
       t))