(hi-lock-mode): Toggling hi-lock-mode now affects all

buffers.  When hi-lock turned on rather than only checking current
buffer for regexps, all buffers are checked. Moved activation of
font-lock to hi-lock-refontify. When font-lock turned off rather
than removing added highlighting just in current buffer, remove it
in all buffers.  Changed edit menu text from "Automatic
Highlighting" to "Regexp Highlighting" Documentation for
highlighting phrases, minor documentation changes.
(hi-lock-set-file-patterns): Execute only if there are new or
existing file patterns.
(hi-lock-refontify): Assume font-lock-fontify-buffer will first
unfontify and, if a support mode is active, will not refontify the
whole buffer.  If necessary, turn on font lock. (Removed
font-lock-unfontify and font-lock support-mode-specific calls,
such as lazy-lock-fontify-window.)
(hi-lock-find-patterns): Do not turn on hi-lock-mode even if
patterns are found. Not useful now since find-file-hook is removed
if hi-lock is off, but may be needed for per-buffer hi-lock
activation.
(hi-lock-face-phrase-buffer): New function.  Also added related
menu item and keybinding.
(highlight-phrase): New alias, to hi-lock-face-phrase-buffer.
(hi-lock-process-phrase): New function.
(hi-lock-line-face-buffer): Doc fixes.
(hi-lock-face-buffer): Doc fixes.
(hi-lock-unface-buffer): Doc fixes.

1 files changed, 82 insertions, 46 deletions

diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 22ae9e7afb2..0ae3dbddce6 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -49,12 +49,12 @@
 ;;
 ;;    When writing text, highlight personal cliches.  This can be
 ;;    amusing.
-;;    M-x highlight-regexp as can be seen RET RET
+;;    M-x highlight-phrase as can be seen RET RET
 ;;
-;;  Setup
+;;  Setup:
 ;;
 ;;    Put the following code in your .emacs file.  This turns on
-;;    hi-lock mode and adds an "Automatic Highlighting" entry
+;;    hi-lock mode and adds a "Regexp Highlighting" entry
 ;;    to the edit menu.
 ;;
 ;;    (hi-lock-mode 1)
@@ -65,6 +65,7 @@
 ;;    (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)
+;;    (define-key hi-lock-map "\C-zp" 'highlight-phrase)
 ;;    (define-key hi-lock-map "\C-zr" 'unhighlight-regexp)
 ;;    (define-key hi-lock-map "\C-zb" 'hi-lock-write-interactive-patterns))
 
@@ -200,6 +201,10 @@ calls."
   '(menu-item "Highlight Regexp..." highlight-regexp
               :help "Highlight text matching PATTERN (a regexp)."))
 
+(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)."))
+
 (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).."))
@@ -223,6 +228,7 @@ calls."
 
 (define-key hi-lock-map "\C-xwi" 'hi-lock-find-patterns)
 (define-key hi-lock-map "\C-xwl" 'highlight-lines-matching-regexp)
+(define-key hi-lock-map "\C-xwp" 'highlight-phrase)
 (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)
@@ -243,13 +249,18 @@ calls."
   "Toggle minor mode for interactively adding font-lock highlighting patterns.
 
 If ARG positive turn hi-lock on.  Issuing a hi-lock command will also
-turn hi-lock on.  When hi-lock is turned on an \"Automatic Highlighting\"
+turn hi-lock on.  When hi-lock is turned on, a \"Regexp Highlighting\"
 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.
 
+\\[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.)
+ 
 \\[highlight-lines-matching-regexp] REGEXP FACE
   Highlight lines containing matches of REGEXP in current buffer with FACE.
 
@@ -278,22 +289,26 @@ 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
-           (if (null arg) (not hi-lock-mode)
-             (> (prefix-numeric-value arg) 0)))
+          (if (null arg) (not hi-lock-mode)
+            (> (prefix-numeric-value arg) 0)))
     ;; Turned on.
     (when (and (not hi-lock-mode-prev) hi-lock-mode)
-      (if (not font-lock-mode) (turn-on-font-lock))
       (add-hook 'find-file-hooks 'hi-lock-find-file-hook)
       (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
       (define-key-after menu-bar-edit-menu [hi-lock]
-        (cons "Automatic Highlighting" hi-lock-menu))
-      (hi-lock-find-patterns))
+        (cons "Regexp Highlighting" hi-lock-menu))
+      (dolist (buffer (buffer-list))
+        (with-current-buffer buffer (hi-lock-find-patterns))))
     ;; Turned off.
     (when (and hi-lock-mode-prev (not hi-lock-mode))
-      (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-refontify)
+      (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)))))
       (define-key-after menu-bar-edit-menu [hi-lock] nil)
       (remove-hook 'find-file-hooks 'hi-lock-find-file-hook)
       (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
@@ -303,7 +318,7 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
 (defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
 ;;;###autoload
 (defun hi-lock-line-face-buffer (regexp &optional face)
-  "Set face of all lines containing matches of REGEXP to FACE.
+  "Set face of all lines containing a match of REGEXP to FACE.
 
 Interactively, prompt for REGEXP then FACE.  Buffer-local history
 list maintained for regexps, global history maintained for faces.
@@ -321,11 +336,12 @@ list maintained for regexps, global history maintained for faces.
   (hi-lock-set-pattern
    (list (concat "^.*" regexp ".*$") (list 0 (list 'quote face) t))))
 
+
 ;;;###autoload
 (defalias 'highlight-regexp 'hi-lock-face-buffer)
 ;;;###autoload
 (defun hi-lock-face-buffer (regexp &optional face)
-  "Set face of all matches of REGEXP to FACE.
+  "Set face of each match of REGEXP to FACE.
 
 Interactively, prompt for REGEXP then FACE.  Buffer-local history
 list maintained for regexps, global history maintained for faces.
@@ -343,14 +359,34 @@ list maintained for regexps, global history maintained for faces.
   (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))
 
 ;;;###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))))
+
+;;;###autoload
 (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
 ;;;###autoload
 (defun hi-lock-unface-buffer (regexp)
-  "Remove highlighting of matches to REGEXP set by hi-lock.
+  "Remove highlighting of each match to REGEXP set by hi-lock.
 
 Interactively, prompt for REGEXP.  Buffer-local history of inserted
 regexp's maintained.  Will accept only regexps inserted by hi-lock
-interactive functions. \(See `hi-lock-interactive-patterns'.\)
+interactive functions.  \(See `hi-lock-interactive-patterns'.\)
 \\<minibuffer-local-must-match-map>Use \\[minibuffer-complete] to complete a partially typed regexp.
 \(See info node `Minibuffer History'.\)"
   (interactive
@@ -416,6 +452,19 @@ be found in variable `hi-lock-interactive-patterns'."
 
 ;; Implementation Functions
 
+(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))))
+
 (defun hi-lock-regexp-okay (regexp)
   "Return REGEXP if it appears suitable for a font-lock pattern.
 
@@ -467,25 +516,17 @@ Optional argument END is maximum excursion."
 
 (defun hi-lock-set-file-patterns (patterns)
   "Replace file patterns list with PATTERNS and refontify."
-  (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))
+  (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)))
 
 (defun hi-lock-refontify ()
   "Unfontify then refontify buffer.  Used when hi-lock patterns change."
   (interactive)
-  (font-lock-unfontify-buffer)
-  (cond
-   (jit-lock-mode (jit-lock-refontify))
-   ;; Need a better way, since this assumes too much about lazy lock.
-   (lazy-lock-mode
-    (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)))
-        (while windows
-          (lazy-lock-fontify-window (car windows))
-          (setq windows (cdr windows)))))
-   (t (font-lock-fontify-buffer))))
-
+  (unless font-lock-mode (font-lock-mode 1))
+  (font-lock-fontify-buffer))
 
 (defun hi-lock-find-patterns ()
   "Find patterns in current buffer for hi-lock."
@@ -499,23 +540,18 @@ Optional argument END is maximum excursion."
         (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")))
-          (let
-              ((patterns
-                (condition-case nil
-                    (read (current-buffer))
-                  (error  (message
-                           (format "Could not read expression at %d"
-                                   (hi-lock-current-line))) nil))))
+        (while (and (re-search-forward target-regexp (+ (point) 100) t)
+                    (not (looking-at "\\s-*end")))
+          (let ((patterns
+                 (condition-case nil
+                     (read (current-buffer))
+                   (error  (message
+                            (format "Could not read expression at %d"
+                                    (hi-lock-current-line))) nil))))
             (if patterns
                 (setq all-patterns (append patterns all-patterns))))))
-      (if (and (not hi-lock-mode) all-patterns)
-          (hi-lock-mode 1))
       (unless font-lock-mode (font-lock-mode))
-      (if hi-lock-mode (hi-lock-set-file-patterns all-patterns))
+      (when hi-lock-mode (hi-lock-set-file-patterns all-patterns))
       (if (interactive-p)
         (message (format "Hi-lock added %d patterns." (length all-patterns)))))))