(truncate-lines, write-file, print-buffer)

[gnu-emacs] / lisp / hi-lock.el

diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 20961226cb513707e9adfa361ca62f56650d8592..14920cf93c2f4d3c8b5a0373defb09f78f729fa6 100644 (file)
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -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


@@ -19,11 +20,11 @@
 
 ;; 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))))
 
 


@@ -334,7 +347,9 @@ list maintained for regexps, global history maintained for faces.
   (unless hi-lock-mode (hi-lock-mode))
   (or (facep face) (setq face 'rwl-yellow))
   (hi-lock-set-pattern
   (unless hi-lock-mode (hi-lock-mode))
   (or (facep face) (setq face 'rwl-yellow))
   (hi-lock-set-pattern

-   (list (concat "^.*" regexp ".*$") (list 0 (list 'quote face) t))))
+   ;; 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))))

 
 
 ;;;###autoload
 
 
 ;;;###autoload


@@ -390,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


@@ -420,7 +435,7 @@ interactive functions.  \(See `hi-lock-interactive-patterns'.\)
          (error "No highlighting to remove"))
        (list
         (completing-read "Regexp to unhighlight: "
          (error "No highlighting to remove"))
        (list
         (completing-read "Regexp to unhighlight: "

-                         hi-lock-interactive-patterns t t
+                         hi-lock-interactive-patterns nil t

                          (car (car hi-lock-interactive-patterns))
                          (cons 'history-list 1))))))
   (let ((keyword (assoc regexp hi-lock-interactive-patterns)))
                          (car (car hi-lock-interactive-patterns))
                          (cons 'history-list 1))))))
   (let ((keyword (assoc regexp hi-lock-interactive-patterns)))


@@ -535,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)))))))


@@ -562,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