hi-lock.el 21.9 KB
Newer Older
1
;;; hi-lock.el --- minor mode for interactive automatic highlighting
Gerd Moellmann's avatar
Gerd Moellmann committed
2

3 4
;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; Author: David M. Koppelman, koppel@ee.lsu.edu
;; Keywords: faces, minor-mode, matching, display

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Gerd Moellmann's avatar
Gerd Moellmann committed
25

26
;;; Commentary:
27
;;
Gerd Moellmann's avatar
Gerd Moellmann committed
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
;;  With the hi-lock commands text matching interactively entered
;;  regexp's can be highlighted.  For example, `M-x highlight-regexp
;;  RET clearly RET RET' will highlight all occurrences of `clearly'
;;  using a yellow background face.  New occurrences of `clearly' will
;;  be highlighted as they are typed.  `M-x unhighlight-regexp RET'
;;  will remove the highlighting.  Any existing face can be used for
;;  highlighting and a set of appropriate faces is provided.  The
;;  regexps can be written into the current buffer in a form that will
;;  be recognized the next time the corresponding file is read.
;;
;;  Applications:
;;
;;    In program source code highlight a variable to quickly see all
;;    places it is modified or referenced:
;;    M-x highlight-regexp ground_contact_switches_closed RET RET
;;
;;    In a shell or other buffer that is showing lots of program
;;    output, highlight the parts of the output you're interested in:
;;    M-x highlight-regexp Total execution time [0-9]+ RET hi-blue-b RET
;;
;;    In buffers displaying tables, highlight the lines you're interested in:
;;    M-x highlight-lines-matching-regexp January 2000 RET hi-black-b RET
;;
;;    When writing text, highlight personal cliches.  This can be
;;    amusing.
53
;;    M-x highlight-phrase as can be seen RET RET
Gerd Moellmann's avatar
Gerd Moellmann committed
54
;;
55
;;  Setup:
Gerd Moellmann's avatar
Gerd Moellmann committed
56 57
;;
;;    Put the following code in your .emacs file.  This turns on
58
;;    hi-lock mode and adds a "Regexp Highlighting" entry
Gerd Moellmann's avatar
Gerd Moellmann committed
59 60 61
;;    to the edit menu.
;;
;;    (hi-lock-mode 1)
62
;;
Gerd Moellmann's avatar
Gerd Moellmann committed
63 64 65 66 67 68
;;    You might also want to bind the hi-lock commands to more
;;    finger-friendly sequences:

;;    (define-key hi-lock-map "\C-z\C-h" 'highlight-lines-matching-regexp)
;;    (define-key hi-lock-map "\C-zi" 'hi-lock-find-patterns)
;;    (define-key hi-lock-map "\C-zh" 'highlight-regexp)
69
;;    (define-key hi-lock-map "\C-zp" 'highlight-phrase)
Gerd Moellmann's avatar
Gerd Moellmann committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83
;;    (define-key hi-lock-map "\C-zr" 'unhighlight-regexp)
;;    (define-key hi-lock-map "\C-zb" 'hi-lock-write-interactive-patterns))

;;    See the documentation for hi-lock-mode `C-h f hi-lock-mode' for
;;    additional instructions.

;; Sample file patterns:

; Hi-lock: (("^;;; .*" (0 (quote hi-black-hb) t)))
; Hi-lock: ( ("make-variable-buffer-\\(local\\)" (0 font-lock-keyword-face)(1 'italic append)))))
; Hi-lock: end

;;; Code:

Eli Zaretskii's avatar
Eli Zaretskii committed
84
(eval-and-compile
Gerd Moellmann's avatar
Gerd Moellmann committed
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
  (require 'font-lock))

(defgroup hi-lock-interactive-text-highlighting nil
  "Interactively add and remove font-lock patterns for highlighting text."
  :group 'faces)

;;;###autoload
(defcustom hi-lock-mode nil
  "Toggle hi-lock, for interactively adding font-lock text-highlighting patterns."
  :set (lambda (symbol value)
         (hi-lock-mode (or value 0)))
  :initialize 'custom-initialize-default
  :type 'boolean
  :group 'hi-lock-interactive-text-highlighting
  :require 'hi-lock)

(defcustom hi-lock-file-patterns-range 10000
  "Limit of search in a buffer for hi-lock patterns.
When a file is visited and hi-lock mode is on patterns starting
up to this limit are added to font-lock's patterns.  See documentation
of functions `hi-lock-mode' and `hi-lock-find-patterns'."
  :type 'integer
  :group 'hi-lock-interactive-text-highlighting)

(defcustom hi-lock-exclude-modes
  '(rmail-mode mime/viewer-mode gnus-article-mode)
  "List of major modes in which hi-lock will not run.
For security reasons since font lock patterns can specify function
calls."
114
  :type '(repeat symbol)
Gerd Moellmann's avatar
Gerd Moellmann committed
115 116 117 118 119 120 121 122
  :group 'hi-lock-interactive-text-highlighting)


(defgroup hi-lock-faces nil
  "Faces for hi-lock."
  :group 'hi-lock-interactive-text-highlighting)

(defface hi-yellow
Kim F. Storm's avatar
Kim F. Storm committed
123
  '((((min-colors 88) (background dark))
124 125 126
     (:background "yellow1" :foreground "black"))
    (((background dark)) (:background "yellow" :foreground "black"))
    (((min-colors 88)) (:background "yellow1"))
127
    (t (:background "yellow")))
Gerd Moellmann's avatar
Gerd Moellmann committed
128 129 130 131
  "Default face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-pink
132
  '((((background dark)) (:background "pink" :foreground "black"))
133
    (t (:background "pink")))
Gerd Moellmann's avatar
Gerd Moellmann committed
134 135 136 137
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-green
Kim F. Storm's avatar
Kim F. Storm committed
138
  '((((min-colors 88) (background dark))
139 140
     (:background "green1" :foreground "black"))
    (((background dark)) (:background "green" :foreground "black"))
Kim F. Storm's avatar
Kim F. Storm committed
141
    (((min-colors 88)) (:background "green1"))
142
    (t (:background "green")))
Gerd Moellmann's avatar
Gerd Moellmann committed
143 144 145 146
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-blue
147
  '((((background dark)) (:background "light blue" :foreground "black"))
148
    (t (:background "light blue")))
Gerd Moellmann's avatar
Gerd Moellmann committed
149 150 151 152 153 154 155 156 157
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-black-b
  '((t (:weight bold)))
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-blue-b
158 159
  '((((min-colors 88)) (:weight bold :foreground "blue1"))
    (t (:weight bold :foreground "blue")))
Gerd Moellmann's avatar
Gerd Moellmann committed
160 161 162 163
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-green-b
164 165
  '((((min-colors 88)) (:weight bold :foreground "green1"))
    (t (:weight bold :foreground "green")))
Gerd Moellmann's avatar
Gerd Moellmann committed
166 167 168 169
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-red-b
170 171
  '((((min-colors 88)) (:weight bold :foreground "red1"))
    (t (:weight bold :foreground "red")))
Gerd Moellmann's avatar
Gerd Moellmann committed
172 173 174 175
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defface hi-black-hb
Miles Bader's avatar
Miles Bader committed
176
  '((t (:weight bold :height 1.67 :inherit variable-pitch)))
Gerd Moellmann's avatar
Gerd Moellmann committed
177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
  "Face for hi-lock mode."
  :group 'hi-lock-faces)

(defvar hi-lock-file-patterns nil
  "Patterns found in file for hi-lock.  Should not be changed.")

(defvar hi-lock-interactive-patterns nil
  "Patterns provided to hi-lock by user.  Should not be changed.")

(defvar hi-lock-face-history
  (list "hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b"
        "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
      "History list of faces for hi-lock interactive functions.")

;(dolist (f hi-lock-face-history) (unless (facep f) (error "%s not a face" f)))

(defvar hi-lock-regexp-history nil
  "History of regexps used for interactive fontification.")

(defvar hi-lock-file-patterns-prefix "Hi-lock"
  "Regexp for finding hi-lock patterns at top of file.")

(make-variable-buffer-local 'hi-lock-interactive-patterns)
(put 'hi-lock-interactive-patterns 'permanent-local t)
(make-variable-buffer-local 'hi-lock-regexp-history)
(put 'hi-lock-regexp-history 'permanent-local t)
(make-variable-buffer-local 'hi-lock-file-patterns)
(put 'hi-lock-file-patterns 'permanent-local t)

(defvar hi-lock-menu (make-sparse-keymap "Hi Lock")
  "Menu for hi-lock mode.")

(define-key-after hi-lock-menu [highlight-regexp]
  '(menu-item "Highlight Regexp..." highlight-regexp
              :help "Highlight text matching PATTERN (a regexp)."))

213 214 215 216
(define-key-after hi-lock-menu [highlight-phrase]
  '(menu-item "Highlight Phrase..." highlight-phrase
              :help "Highlight text matching PATTERN (a regexp processed to match phrases)."))

Gerd Moellmann's avatar
Gerd Moellmann committed
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
(define-key-after hi-lock-menu [highlight-lines-matching-regexp]
  '(menu-item "Highlight Lines..." highlight-lines-matching-regexp
              :help "Highlight lines containing match of PATTERN (a regexp).."))

(define-key-after hi-lock-menu [unhighlight-regexp]
  '(menu-item "Remove Highlighting..." unhighlight-regexp
              :help "Remove previously entered highlighting pattern."
              :enable hi-lock-interactive-patterns))

(define-key-after hi-lock-menu [hi-lock-write-interactive-patterns]
  '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns
              :help "Insert interactively added REGEXPs into buffer at point."
              :enable hi-lock-interactive-patterns))

(define-key-after hi-lock-menu [hi-lock-find-patterns]
  '(menu-item "Patterns from Buffer" hi-lock-find-patterns
              :help "Use patterns (if any) near top of buffer."))

(defvar hi-lock-map (make-sparse-keymap "Hi Lock")
  "Key map for hi-lock.")

(define-key hi-lock-map "\C-xwi" 'hi-lock-find-patterns)
(define-key hi-lock-map "\C-xwl" 'highlight-lines-matching-regexp)
240
(define-key hi-lock-map "\C-xwp" 'highlight-phrase)
Gerd Moellmann's avatar
Gerd Moellmann committed
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
(define-key hi-lock-map "\C-xwh" 'highlight-regexp)
(define-key hi-lock-map "\C-xwr" 'unhighlight-regexp)
(define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns)

(unless (assq 'hi-lock-mode minor-mode-map-alist)
  (setq minor-mode-map-alist (cons (cons 'hi-lock-mode hi-lock-map)
                                   minor-mode-map-alist)))

(unless (assq 'hi-lock-mode minor-mode-alist)
  (setq minor-mode-alist (cons '(hi-lock-mode " H") minor-mode-alist)))


;; Visible Functions


;;;###autoload
(defun hi-lock-mode (&optional arg)
  "Toggle minor mode for interactively adding font-lock highlighting patterns.

If ARG positive turn hi-lock on.  Issuing a hi-lock command will also
261
turn hi-lock on.  When hi-lock is turned on, a \"Regexp Highlighting\"
Gerd Moellmann's avatar
Gerd Moellmann committed
262 263 264 265 266 267
submenu is added to the \"Edit\" menu.  The commands in the submenu,
which can be called interactively, are:

\\[highlight-regexp] REGEXP FACE
  Highlight matches of pattern REGEXP in current buffer with FACE.

268 269 270 271
\\[highlight-phrase] PHRASE FACE
  Highlight matches of phrase PHRASE in current buffer with FACE.
  (PHRASE can be any REGEXP, but spaces will be replaced by matches
  to whitespace and initial lower-case letters will become case insensitive.)
272

Gerd Moellmann's avatar
Gerd Moellmann committed
273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300
\\[highlight-lines-matching-regexp] REGEXP FACE
  Highlight lines containing matches of REGEXP in current buffer with FACE.

\\[unhighlight-regexp] REGEXP
  Remove highlighting on matches of REGEXP in current buffer.

\\[hi-lock-write-interactive-patterns]
  Write active REGEXPs into buffer as comments (if possible). They will
  be read the next time file is loaded or when the \\[hi-lock-find-patterns] command
  is issued.  The inserted regexps are in the form of font lock keywords.
  (See `font-lock-keywords') They may be edited and re-loaded with \\[hi-lock-find-patterns],
  any valid `font-lock-keywords' form is acceptable.

\\[hi-lock-find-patterns]
  Re-read patterns stored in buffer (in the format produced by \\[hi-lock-write-interactive-patterns]).

When hi-lock is started and if the mode is not excluded, the
beginning of the buffer is searched for lines of the form:
  Hi-lock: FOO
where FOO is a list of patterns. These are added to the font lock keywords
already present.  The patterns must start before position (number
of characters into buffer) `hi-lock-file-patterns-range'.  Patterns
will be read until
 Hi-lock: end
is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
  (interactive)
  (let ((hi-lock-mode-prev hi-lock-mode))
    (setq hi-lock-mode
301 302
          (if (null arg) (not hi-lock-mode)
            (> (prefix-numeric-value arg) 0)))
Gerd Moellmann's avatar
Gerd Moellmann committed
303 304
    ;; Turned on.
    (when (and (not hi-lock-mode-prev) hi-lock-mode)
305
      (add-hook 'find-file-hook 'hi-lock-find-file-hook)
Gerd Moellmann's avatar
Gerd Moellmann committed
306
      (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
307 308 309 310
      (when (eq nil font-lock-defaults)
	(setq font-lock-defaults '(nil)))
      (unless font-lock-mode
	(font-lock-mode 1))
Gerd Moellmann's avatar
Gerd Moellmann committed
311
      (define-key-after menu-bar-edit-menu [hi-lock]
312 313 314
        (cons "Regexp Highlighting" hi-lock-menu))
      (dolist (buffer (buffer-list))
        (with-current-buffer buffer (hi-lock-find-patterns))))
Gerd Moellmann's avatar
Gerd Moellmann committed
315 316
    ;; Turned off.
    (when (and hi-lock-mode-prev (not hi-lock-mode))
317 318 319 320 321 322 323 324
      (dolist (buffer (buffer-list))
        (with-current-buffer buffer
          (when (or hi-lock-interactive-patterns hi-lock-file-patterns)
            (font-lock-remove-keywords nil hi-lock-interactive-patterns)
            (font-lock-remove-keywords nil hi-lock-file-patterns)
            (setq hi-lock-interactive-patterns nil
                  hi-lock-file-patterns nil)
            (when font-lock-mode (hi-lock-refontify)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
325
      (define-key-after menu-bar-edit-menu [hi-lock] nil)
326
      (remove-hook 'find-file-hook 'hi-lock-find-file-hook)
Gerd Moellmann's avatar
Gerd Moellmann committed
327 328 329 330 331 332 333
      (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))


;;;###autoload
(defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
;;;###autoload
(defun hi-lock-line-face-buffer (regexp &optional face)
334
  "Set face of all lines containing a match of REGEXP to FACE.
Gerd Moellmann's avatar
Gerd Moellmann committed
335 336 337 338

Interactively, prompt for REGEXP then FACE.  Buffer-local history
list maintained for regexps, global history maintained for faces.
\\<minibuffer-local-map>Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item.
339
\(See info node `Minibuffer History')"
Gerd Moellmann's avatar
Gerd Moellmann committed
340 341 342 343 344 345 346 347 348 349
  (interactive
   (list
    (hi-lock-regexp-okay
     (read-from-minibuffer "Regexp to highlight line: "
                           (cons (or (car hi-lock-regexp-history) "") 1 )
                           nil nil 'hi-lock-regexp-history))
    (hi-lock-read-face-name)))
  (unless hi-lock-mode (hi-lock-mode))
  (or (facep face) (setq face 'rwl-yellow))
  (hi-lock-set-pattern
350 351 352
   ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
   ;; or a trailing $ in REGEXP will be interpreted correctly.
   (list (concat "^.*\\(?:" regexp "\\).*$") (list 0 (list 'quote face) t))))
Gerd Moellmann's avatar
Gerd Moellmann committed
353

354

Gerd Moellmann's avatar
Gerd Moellmann committed
355 356 357 358
;;;###autoload
(defalias 'highlight-regexp 'hi-lock-face-buffer)
;;;###autoload
(defun hi-lock-face-buffer (regexp &optional face)
359
  "Set face of each match of REGEXP to FACE.
Gerd Moellmann's avatar
Gerd Moellmann committed
360 361 362 363

Interactively, prompt for REGEXP then FACE.  Buffer-local history
list maintained for regexps, global history maintained for faces.
\\<minibuffer-local-map>Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item.
364
\(See info node `Minibuffer History')"
Gerd Moellmann's avatar
Gerd Moellmann committed
365 366 367 368 369 370 371 372 373 374 375
  (interactive
   (list
    (hi-lock-regexp-okay
     (read-from-minibuffer "Regexp to highlight: "
                           (cons (or (car hi-lock-regexp-history) "") 1 )
                           nil nil 'hi-lock-regexp-history))
    (hi-lock-read-face-name)))
  (or (facep face) (setq face 'rwl-yellow))
  (unless hi-lock-mode (hi-lock-mode))
  (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))

376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395
;;;###autoload
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
;;;###autoload
(defun hi-lock-face-phrase-buffer (regexp &optional face)
  "Set face of each match of phrase REGEXP to FACE.

Whitespace in REGEXP converted to arbitrary whitespace and initial
lower-case letters made case insensitive."
  (interactive
   (list
    (hi-lock-regexp-okay
     (hi-lock-process-phrase
      (read-from-minibuffer "Phrase to highlight: "
                            (cons (or (car hi-lock-regexp-history) "") 1 )
                            nil nil 'hi-lock-regexp-history)))
    (hi-lock-read-face-name)))
  (or (facep face) (setq face 'rwl-yellow))
  (unless hi-lock-mode (hi-lock-mode))
  (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))

Gerd Moellmann's avatar
Gerd Moellmann committed
396 397 398 399
;;;###autoload
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
;;;###autoload
(defun hi-lock-unface-buffer (regexp)
400
  "Remove highlighting of each match to REGEXP set by hi-lock.
Gerd Moellmann's avatar
Gerd Moellmann committed
401 402 403

Interactively, prompt for REGEXP.  Buffer-local history of inserted
regexp's maintained.  Will accept only regexps inserted by hi-lock
404
interactive functions.  \(See `hi-lock-interactive-patterns'.\)
Gerd Moellmann's avatar
Gerd Moellmann committed
405
\\<minibuffer-local-must-match-map>Use \\[minibuffer-complete] to complete a partially typed regexp.
406
\(See info node `Minibuffer History'.\)"
Gerd Moellmann's avatar
Gerd Moellmann committed
407
  (interactive
408
   (if (and (display-popup-menus-p) (vectorp (this-command-keys)))
409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431
       (catch 'snafu
	 (or
	  (x-popup-menu
	   t
	   (cons
	    `keymap
	    (cons "Select Pattern to Unhighlight"
		  (mapcar (lambda (pattern)
			    (list (car pattern)
				  (format
				   "%s (%s)" (car pattern)
				   (symbol-name
				    (car
				     (cdr (car (cdr (car (cdr pattern))))))))
				  (cons nil nil)
				  (car pattern)))
			  hi-lock-interactive-patterns))))
	  ;; If the user clicks outside the menu, meaning that they
	  ;; change their mind, x-popup-menu returns nil, and
	  ;; interactive signals a wrong number of arguments error.
	  ;; To prevent that, we return an empty string, which will
	  ;; effectively disable the rest of the function.
	  (throw 'snafu '(""))))
Gerd Moellmann's avatar
Gerd Moellmann committed
432 433 434 435 436 437
     (let ((history-list (mapcar (lambda (p) (car p))
                                 hi-lock-interactive-patterns)))
       (unless hi-lock-interactive-patterns
         (error "No highlighting to remove"))
       (list
        (completing-read "Regexp to unhighlight: "
438
                         hi-lock-interactive-patterns nil t
Gerd Moellmann's avatar
Gerd Moellmann committed
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469
                         (car (car hi-lock-interactive-patterns))
                         (cons 'history-list 1))))))
  (let ((keyword (assoc regexp hi-lock-interactive-patterns)))
    (when keyword
      (font-lock-remove-keywords nil (list keyword))
      (setq hi-lock-interactive-patterns
            (delq keyword hi-lock-interactive-patterns))
      (hi-lock-refontify))))

;;;###autoload
(defun hi-lock-write-interactive-patterns ()
  "Write interactively added patterns, if any, into buffer at point.

Interactively added patterns are those normally specified using
`highlight-regexp' and `highlight-lines-matching-regexp'; they can
be found in variable `hi-lock-interactive-patterns'."
  (interactive)
  (let ((prefix (format "%s %s:" (or comment-start "") "Hi-lock")))
    (when (> (+ (point) (length prefix)) hi-lock-file-patterns-range)
      (beep)
      (message
       "Warning, inserted keywords not close enough to top of file."))
    (mapcar
     (lambda (pattern)
       (insert (format "%s (%s) %s\n"
                       prefix (prin1-to-string pattern) (or comment-end ""))))
     hi-lock-interactive-patterns)))


;; Implementation Functions

470 471 472 473 474 475 476 477 478 479 480 481 482
(defun hi-lock-process-phrase (phrase)
  "Convert regexp PHRASE to a regexp that matches phrases.

Blanks in PHRASE replaced by regexp that matches arbitrary whitespace
and initial lower-case letters made case insensitive."
  (let ((mod-phrase nil))
    (setq mod-phrase
          (replace-regexp-in-string
           "\\<[a-z]" (lambda (m) (format "[%s%s]" (upcase m) m)) phrase))
    (setq mod-phrase
          (replace-regexp-in-string
           "\\s-+" "[ \t\n]+" mod-phrase nil t))))

Gerd Moellmann's avatar
Gerd Moellmann committed
483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533
(defun hi-lock-regexp-okay (regexp)
  "Return REGEXP if it appears suitable for a font-lock pattern.

Otherwise signal an error.  A pattern that matches the null string is
not suitable."
  (if (string-match regexp "")
      (error "Regexp cannot match an empty string")
    regexp))

(defun hi-lock-read-face-name ()
  "Read face name from minibuffer with completion and history."
  (intern (completing-read
           "Highlight using face: "
           obarray 'facep t
           (cons (car hi-lock-face-history)
                 (let ((prefix
                        (try-completion
                         (substring (car hi-lock-face-history) 0 1)
                         (mapcar (lambda (f) (cons f f))
                                 hi-lock-face-history))))
                   (if (and (stringp prefix)
                            (not (equal prefix (car hi-lock-face-history))))
                       (length prefix) 0)))
           '(hi-lock-face-history . 0))))

(defun hi-lock-find-file-hook ()
  "Add hi-lock patterns, if present."
  (hi-lock-find-patterns))

(defun hi-lock-current-line (&optional end)
  "Return line number of line at point.
Optional argument END is maximum excursion."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (1+ (count-lines 1 (or end (point))))))

(defun hi-lock-set-pattern (pattern)
  "Add PATTERN to list of interactively highlighted patterns and refontify."
  (hi-lock-set-patterns (list pattern)))

(defun hi-lock-set-patterns (patterns)
  "Add PATTERNS to list of interactively highlighted patterns and refontify.."
  (dolist (pattern patterns)
    (unless (member pattern hi-lock-interactive-patterns)
      (font-lock-add-keywords nil (list pattern))
      (add-to-list 'hi-lock-interactive-patterns pattern)))
  (hi-lock-refontify))

(defun hi-lock-set-file-patterns (patterns)
  "Replace file patterns list with PATTERNS and refontify."
534 535 536 537 538
  (when (or hi-lock-file-patterns patterns)
    (font-lock-remove-keywords nil hi-lock-file-patterns)
    (setq hi-lock-file-patterns patterns)
    (font-lock-add-keywords nil hi-lock-file-patterns)
    (hi-lock-refontify)))
Gerd Moellmann's avatar
Gerd Moellmann committed
539 540 541 542

(defun hi-lock-refontify ()
  "Unfontify then refontify buffer.  Used when hi-lock patterns change."
  (interactive)
543 544
  (unless font-lock-mode (font-lock-mode 1))
  (font-lock-fontify-buffer))
Gerd Moellmann's avatar
Gerd Moellmann committed
545 546 547 548 549 550 551 552

(defun hi-lock-find-patterns ()
  "Find patterns in current buffer for hi-lock."
  (interactive)
  (unless (memq major-mode hi-lock-exclude-modes)
    (let ((all-patterns nil)
          (target-regexp (concat "\\<" hi-lock-file-patterns-prefix ":")))
      (save-excursion
Stefan Monnier's avatar
Stefan Monnier committed
553 554 555 556 557 558 559 560
	(save-restriction
	  (widen)
	  (goto-char (point-min))
	  (re-search-forward target-regexp
			     (+ (point) hi-lock-file-patterns-range) t)
	  (beginning-of-line)
	  (while (and (re-search-forward target-regexp (+ (point) 100) t)
		      (not (looking-at "\\s-*end")))
561 562 563 564
            (condition-case nil
                (setq all-patterns (append (read (current-buffer)) all-patterns))
              (error (message "Invalid pattern list expression at %d"
                              (hi-lock-current-line)))))))
565
      (when hi-lock-mode (hi-lock-set-file-patterns all-patterns))
Gerd Moellmann's avatar
Gerd Moellmann committed
566
      (if (interactive-p)
Deepak Goel's avatar
Deepak Goel committed
567
        (message "Hi-lock added %d patterns." (length all-patterns))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
568 569 570 571 572 573 574 575 576

(defun hi-lock-font-lock-hook ()
  "Add hi lock patterns to font-lock's."
  (when hi-lock-mode
    (font-lock-add-keywords nil hi-lock-file-patterns)
    (font-lock-add-keywords nil hi-lock-interactive-patterns)))

(provide 'hi-lock)

577
;; arch-tag: d2e8fd07-4cc9-4c6f-a200-1e729bc54066
Gerd Moellmann's avatar
Gerd Moellmann committed
578
;;; hi-lock.el ends here