changeset 35926:d2997845573f

(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.

--- a/lisp/hi-lock.el	Tue Feb 06 13:58:18 2001 +0000
+++ b/lisp/hi-lock.el	Tue Feb 06 15:43:37 2001 +0000
@@ -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 @@
   '(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 @@
 
 (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 @@
   "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 @@
   (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 @@
 (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 @@
   (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 @@
   (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 @@
 
 ;; 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 @@
 
 (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 @@
         (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)))))))