* progmodes/sh-script.el (sh-mode): Use define-derived-mode.

[bpt/emacs.git] / lisp / hi-lock.el

diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 7226433..de4e2ff 100644 (file)
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -1,9 +1,9 @@
 ;;; hi-lock.el --- minor mode for interactive automatic highlighting
 
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;;   2008, 2009, 2010 Free Software Foundation, Inc.
 
-;; Author: David M. Koppelman, koppel@ece.lsu.edu
+;; Author: David M. Koppelman <koppel@ece.lsu.edu>
 ;; Keywords: faces, minor-mode, matching, display
 
 ;; This file is part of GNU Emacs.
@@ -206,15 +206,20 @@ patterns."
 (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.")
+(defvar hi-lock-face-defaults
+  '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b"
+    "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
+  "Default faces for hi-lock interactive functions.")
 
-;(dolist (f hi-lock-face-history) (unless (facep f) (error "%s not a face" f)))
+;(dolist (f hi-lock-face-defaults) (unless (facep f) (error "%s not a face" f)))
 
-(defvar hi-lock-regexp-history nil
-  "History of regexps used for interactive fontification.")
+(define-obsolete-variable-alias 'hi-lock-face-history
+                                'hi-lock-face-defaults
+                                "23.1")
+
+(define-obsolete-variable-alias 'hi-lock-regexp-history
+                                'regexp-history
+                                "23.1")
 
 (defvar hi-lock-file-patterns-prefix "Hi-lock"
   "Search target for finding hi-lock patterns at top of file.")
@@ -232,8 +237,6 @@ a library is being loaded.")
 
 (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)
 
@@ -250,7 +253,7 @@ a library is being loaded.")
 
 (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).."))
+              :help "Highlight lines containing match of PATTERN (a regexp)."))
 
 (define-key-after hi-lock-menu [unhighlight-regexp]
   '(menu-item "Remove Highlighting..." unhighlight-regexp
@@ -335,7 +338,7 @@ is found.  A mode is excluded if it's in the list `hi-lock-exclude-modes'."
   :keymap hi-lock-map
   (when (and (equal (buffer-name) "*scratch*")
              load-in-progress
-             (not (interactive-p))
+             (not (called-interactively-p 'interactive))
              (not hi-lock-archaic-interface-message-used))
     (setq hi-lock-archaic-interface-message-used t)
     (if hi-lock-archaic-interface-deduce
@@ -390,14 +393,13 @@ versions before 22 use the following in your .emacs file:
 
 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.
+\\<minibuffer-local-map>Use \\[previous-history-element] to retrieve previous history items,
+and \\[next-history-element] to retrieve default values.
 \(See info node `Minibuffer History'.)"
   (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))
+     (read-regexp "Regexp to highlight line" (car regexp-history)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -415,14 +417,13 @@ list maintained for regexps, global history maintained for faces.
 
 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.
+\\<minibuffer-local-map>Use \\[previous-history-element] to retrieve previous history items,
+and \\[next-history-element] to retrieve default values.
 \(See info node `Minibuffer History'.)"
   (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))
+     (read-regexp "Regexp to highlight" (car regexp-history)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -440,14 +441,14 @@ lower-case letters made case insensitive."
    (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)))
+      (read-regexp "Phrase to highlight" (car regexp-history))))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
   (hi-lock-set-pattern regexp face))
 
+(declare-function x-popup-menu "menu.c" (position menu))
+
 ;;;###autoload
 (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
 ;;;###autoload
@@ -552,20 +553,29 @@ not suitable."
   (intern (completing-read
            "Highlight using face: "
            obarray 'facep t
-           (cons (car hi-lock-face-history)
+           (cons (car hi-lock-face-defaults)
                  (let ((prefix
                         (try-completion
-                         (substring (car hi-lock-face-history) 0 1)
-                         (mapcar (lambda (f) (cons f f))
-                                 hi-lock-face-history))))
+                         (substring (car hi-lock-face-defaults) 0 1)
+                         hi-lock-face-defaults)))
                    (if (and (stringp prefix)
-                            (not (equal prefix (car hi-lock-face-history))))
+                            (not (equal prefix (car hi-lock-face-defaults))))
                        (length prefix) 0)))
-           '(hi-lock-face-history . 0))))
+           'face-name-history
+          (cdr hi-lock-face-defaults))))
+
+(defvar hi-lock--inhibit-font-lock-hook nil
+  "Inhibit the action of `hi-lock-font-lock-hook'.
+This is used by `hi-lock-set-pattern'.")
 
 (defun hi-lock-set-pattern (regexp face)
   "Highlight REGEXP with face FACE."
-  (let ((pattern (list regexp (list 0 (list 'quote face) t))))
+  (let ((pattern (list regexp (list 0 (list 'quote face) t)))
+       ;; The call to `font-lock-add-keywords' below might disable
+       ;; and re-enable font-lock mode.  If so, we don't want
+       ;; `hi-lock-font-lock-hook' to run.  This can be removed once
+       ;; Bug#635 is fixed. -- cyd
+       (hi-lock--inhibit-font-lock-hook t))
     (unless (member pattern hi-lock-interactive-patterns)
       (font-lock-add-keywords nil (list pattern) t)
       (push pattern hi-lock-interactive-patterns)
@@ -626,16 +636,17 @@ not suitable."
                    (y-or-n-p "Add patterns from this buffer to hi-lock? "))
                   (t nil)))
         (hi-lock-set-file-patterns all-patterns)
-        (if (interactive-p)
+        (if (called-interactively-p 'interactive)
             (message "Hi-lock added %d patterns." (length all-patterns)))))))
 
 (defun hi-lock-font-lock-hook ()
   "Add hi-lock patterns to font-lock's."
-  (if font-lock-mode
-      (progn
-       (font-lock-add-keywords nil hi-lock-file-patterns t)
-       (font-lock-add-keywords nil hi-lock-interactive-patterns t))
-    (hi-lock-mode -1)))
+  (unless hi-lock--inhibit-font-lock-hook
+    (if font-lock-mode
+       (progn
+         (font-lock-add-keywords nil hi-lock-file-patterns t)
+         (font-lock-add-keywords nil hi-lock-interactive-patterns t))
+      (hi-lock-mode -1))))
 
 (defvar hi-lock-string-serialize-hash
   (make-hash-table :test 'equal)