]> code.delx.au - gnu-emacs/blobdiff - lisp/hi-lock.el
(truncate-lines, write-file, print-buffer)
[gnu-emacs] / lisp / hi-lock.el
index e37cb94d1a96d35b5928b0ead11223ae9aadb1da..14920cf93c2f4d3c8b5a0373defb09f78f729fa6 100644 (file)
@@ -1,6 +1,7 @@
-;;; hi-lock.el --- Minor mode for interactive automatic highlighting.
+;;; hi-lock.el --- minor mode for interactive automatic highlighting
 
 
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: David M. Koppelman, koppel@ee.lsu.edu
 ;; Keywords: faces, minor-mode, matching, display
 
 ;; Author: David M. Koppelman, koppel@ee.lsu.edu
 ;; Keywords: faces, minor-mode, matching, display
 
 ;; 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
 
 ;; 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
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 
-;;; Commentary
-;; 
+;;; Commentary:
+;;
 ;;  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'
 ;;  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'
@@ -58,7 +59,7 @@
 ;;    to the edit menu.
 ;;
 ;;    (hi-lock-mode 1)
 ;;    to the edit menu.
 ;;
 ;;    (hi-lock-mode 1)
-;;  
+;;
 ;;    You might also want to bind the hi-lock commands to more
 ;;    finger-friendly sequences:
 
 ;;    You might also want to bind the hi-lock commands to more
 ;;    finger-friendly sequences:
 
@@ -83,7 +84,6 @@
 (eval-and-compile
   (require 'font-lock))
 
 (eval-and-compile
   (require 'font-lock))
 
-;;;###autoload
 (defgroup hi-lock-interactive-text-highlighting nil
   "Interactively add and remove font-lock patterns for highlighting text."
   :group 'faces)
 (defgroup hi-lock-interactive-text-highlighting nil
   "Interactively add and remove font-lock patterns for highlighting text."
   :group 'faces)
@@ -120,7 +120,10 @@ calls."
   :group 'hi-lock-interactive-text-highlighting)
 
 (defface hi-yellow
   :group 'hi-lock-interactive-text-highlighting)
 
 (defface hi-yellow
-  '((((background dark)) (:background "yellow" :foreground "black"))
+  '((((min-colors 88) (background dark))
+     (:background "yellow1" :foreground "black"))
+    (((background dark)) (:background "yellow" :foreground "black"))
+    (((min-colors 88)) (:background "yellow1"))
     (t (:background "yellow")))
   "Default face for hi-lock mode."
   :group 'hi-lock-faces)
     (t (:background "yellow")))
   "Default face for hi-lock mode."
   :group 'hi-lock-faces)
@@ -132,7 +135,10 @@ calls."
   :group 'hi-lock-faces)
 
 (defface hi-green
   :group 'hi-lock-faces)
 
 (defface hi-green
-  '((((background dark)) (:background "green" :foreground "black"))
+  '((((min-colors 88) (background dark))
+     (:background "green1" :foreground "black"))
+    (((background dark)) (:background "green" :foreground "black"))
+    (((min-colors 88)) (:background "green1"))
     (t (:background "green")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
     (t (:background "green")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
@@ -149,17 +155,20 @@ calls."
   :group 'hi-lock-faces)
 
 (defface hi-blue-b
   :group 'hi-lock-faces)
 
 (defface hi-blue-b
-  '((t (:weight bold :foreground "blue")))
+  '((((min-colors 88)) (:weight bold :foreground "blue1"))
+    (t (:weight bold :foreground "blue")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
 (defface hi-green-b
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
 (defface hi-green-b
-  '((t (:weight bold :foreground "green")))
+  '((((min-colors 88)) (:weight bold :foreground "green1"))
+    (t (:weight bold :foreground "green")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
 (defface hi-red-b
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
 (defface hi-red-b
-  '((t (:weight bold :foreground "red")))
+  '((((min-colors 88)) (:weight bold :foreground "red1"))
+    (t (:weight bold :foreground "red")))
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
   "Face for hi-lock mode."
   :group 'hi-lock-faces)
 
@@ -260,7 +269,7 @@ which can be called interactively, are:
   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 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.
 
 \\[highlight-lines-matching-regexp] REGEXP FACE
   Highlight lines containing matches of REGEXP in current buffer with FACE.
 
@@ -293,8 +302,12 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
             (> (prefix-numeric-value arg) 0)))
     ;; Turned on.
     (when (and (not hi-lock-mode-prev) hi-lock-mode)
             (> (prefix-numeric-value arg) 0)))
     ;; Turned on.
     (when (and (not hi-lock-mode-prev) hi-lock-mode)
-      (add-hook 'find-file-hooks 'hi-lock-find-file-hook)
+      (add-hook 'find-file-hook 'hi-lock-find-file-hook)
       (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
       (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
+      (when (eq nil font-lock-defaults)
+       (setq font-lock-defaults '(nil)))
+      (unless font-lock-mode
+       (font-lock-mode 1))
       (define-key-after menu-bar-edit-menu [hi-lock]
         (cons "Regexp Highlighting" hi-lock-menu))
       (dolist (buffer (buffer-list))
       (define-key-after menu-bar-edit-menu [hi-lock]
         (cons "Regexp Highlighting" hi-lock-menu))
       (dolist (buffer (buffer-list))
@@ -310,7 +323,7 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
                   hi-lock-file-patterns nil)
             (when font-lock-mode (hi-lock-refontify)))))
       (define-key-after menu-bar-edit-menu [hi-lock] 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 'find-file-hook 'hi-lock-find-file-hook)
       (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
 
 
       (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
 
 
@@ -392,7 +405,7 @@ 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
 \\<minibuffer-local-must-match-map>Use \\[minibuffer-complete] to complete a partially typed regexp.
 \(See info node `Minibuffer History'.\)"
   (interactive
-   (if (vectorp (this-command-keys))
+   (if (and (display-popup-menus-p) (vectorp (this-command-keys)))
        (catch 'snafu
         (or
          (x-popup-menu
        (catch 'snafu
         (or
          (x-popup-menu
@@ -537,21 +550,18 @@ Optional argument END is maximum excursion."
     (let ((all-patterns nil)
           (target-regexp (concat "\\<" hi-lock-file-patterns-prefix ":")))
       (save-excursion
     (let ((all-patterns nil)
           (target-regexp (concat "\\<" hi-lock-file-patterns-prefix ":")))
       (save-excursion
-        (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")))
-          (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))))))
+       (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")))
+            (condition-case nil
+                (setq all-patterns (append (read (current-buffer)) all-patterns))
+              (error (message "Invalid pattern list expression at %d"
+                              (hi-lock-current-line)))))))
       (when hi-lock-mode (hi-lock-set-file-patterns all-patterns))
       (if (interactive-p)
         (message (format "Hi-lock added %d patterns." (length 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)))))))
@@ -564,4 +574,5 @@ Optional argument END is maximum excursion."
 
 (provide 'hi-lock)
 
 
 (provide 'hi-lock)
 
+;; arch-tag: d2e8fd07-4cc9-4c6f-a200-1e729bc54066
 ;;; hi-lock.el ends here
 ;;; hi-lock.el ends here