;;; p-whim-lock.el --- Minor mode for interactive automatic highlighting. ;; Author: David M. Koppelman, koppel@ee.lsu.edu ;;; Commentary ;; ;; With the p-whim-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' ;; using a yellow background face. New occurrences of `clearly' will ;; be highlighted as they are typed. `M-x unhighlight-regexp RET' ;; will remove the highlighting. Any existing face can be used for ;; highlighting and a set of appropriate faces is provided. The ;; regexps can be written into the current buffer in a form that will ;; be recognized the next time the corresponding file is read. ;; ;; An updated version of this package (renamed hi-lock) will be included ;; in Emacs 21. ;; ;; Applications: ;; ;; In program source code highlight a variable to quickly see all ;; places it is modified or referenced: ;; M-x highlight-regexp ground_contact_switches_closed RET RET ;; ;; In a shell or other buffer that is showing lots of program ;; output, highlight the parts of the output you're interested in: ;; M-x highlight-regexp Total execution time [0-9]+ RET hi-blue-b RET ;; ;; In buffers displaying tables, highlight the lines you're interested in: ;; M-x highlight-lines-matching-regexp January 2000 RET hi-black-b RET ;; ;; When writing text, highlight personal cliches. This can be ;; amusing. ;; M-x highlight-regexp as can be seen RET RET ;; ;; Setup: ;; ;; Put the following code in your .emacs file, possibly changing ;; the key bindings in the global-set-key functions. ;; ;; (if window-system ;; (progn ;; (require 'p-whim-lock) ;; (global-set-key "\C-xwi" 'p-whim-lock-find-patterns) ;; (global-set-key "\C-xwh" 'p-whim-lock-face-buffer) ;; (global-set-key "\C-xwr" 'p-whim-lock-unface-buffer) ;; (global-set-key "\C-xwb" 'p-whim-lock-write-interactive-patterns))) ;; ;; Re-start Emacs or evaluate the added code. ;; ;; Go to a buffer in which font-lock is turned on. ;; ;; To highlight all occurrences of the word "the" type \C-xwh the RET RET. ;; To remove highlighting type \C-xwr. ;; To save highlight patterns at the point type \C-xwb. ;; To re-read saved patterns type \C-xwi. ;; Whim-lock: (("\\<\\(setq\\|interactive\\|list\\|intern\\|mapcar\\|lambda\\)\\>" . font-lock-keyword-face)) ;; Whim-lock: (("make-variable-buffer-\\(local\\)" (0 font-lock-keyword-face)(1 'italic append))) ; Whim-lock: (("^;;;.*" (0 (quote bold) t))) ;; Whim-lock: end ;;; Version ;; ;; Version numbers may appear in a future version. ;; This version copied: 19 May 2001, 9:53:22 CDT ;; ;; Get the latest version via http://www.ee.lsu.edu/koppel/lisp/p-whim-lock.el ;;; History: ;; ;;; Code: (defvar whim-lock-mode nil "Whim lock mode.") (defvar p-whim-lock-file-keywords nil "Keywords found in file for whim lock.") (defvar p-whim-lock-original-keywords nil "Saved font lock keywords, used whenever whim-lock keywords change.") (defvar p-whim-lock-exclude-modes '(rmail-mode mime/viewer-mode) "List of major modes in which whim lock will not run. Perhaps for security reasons.") (defvar p-whim-lock-interactive-keywords nil "Keywords provided to whim-lock by user.") (defvar p-whim-lock-face-history (list "hi-yellow" "hi-blue" "hi-pink" "hi-green" "bwl-black" "bwl-blue" "bwl-red" ) "History list of faces for whim-lock interactive functions.") (defvar p-whim-lock-regexp-history nil "History of regexps used for interactive fontification.") (make-variable-buffer-local 'p-whim-lock-original-keywords) (make-variable-buffer-local 'p-whim-lock-interactive-keywords) (put 'p-whim-lock-interactive-keywords 'permanent-local t) (make-variable-buffer-local 'p-whim-lock-regexp-history) (put 'p-whim-lock-regexp-history 'permanent-local t) (make-variable-buffer-local 'p-whim-lock-file-keywords) (put 'p-whim-lock-file-keywords 'permanent-local t) (make-variable-buffer-local 'whim-lock-mode) (put 'whim-lock-mode 'permanent-local t) (if window-system (progn (copy-face 'default 'hi-yellow) (set-face-background 'hi-yellow "yellow") (copy-face 'default 'hi-pink) (set-face-background 'hi-pink "pink") (copy-face 'default 'hi-green) (set-face-background 'hi-green "green") (copy-face 'default 'hi-blue) (set-face-background 'hi-blue "light blue") (copy-face 'default 'bwl-black) (make-face-bold 'bwl-black) (copy-face 'default 'bwl-blue) (set-face-foreground 'bwl-blue "blue") (make-face-bold 'bwl-blue) (copy-face 'default 'bwl-red) (set-face-foreground 'bwl-red "red") (make-face-bold 'bwl-red))) (or (assq 'whim-lock-mode minor-mode-alist) (setq minor-mode-alist (cons '(whim-lock-mode " W") minor-mode-alist))) ;; Visible Functions (defalias 'highlight-lines-matching-regexp 'p-whim-lock-line-face-buffer) (defun p-whim-lock-line-face-buffer (regexp &optional face) "Set face of each lines containing a match of REGEXP to FACE." (interactive (list (read-from-minibuffer "Regexp to highlight line: " (cons (or (car p-whim-lock-regexp-history) "") 1 ) nil nil 'p-whim-lock-regexp-history) (intern (completing-read "Highlight using face: " obarray 'facep t (car p-whim-lock-face-history) '(p-whim-lock-face-history . 0))))) (if (or (not (stringp regexp)) (= (length regexp) 0)) (error "Invalid regexp")) (if (not whim-lock-mode) (whim-lock-mode)) (or (facep face) (setq face 'hi-yellow)) (add-to-list 'p-whim-lock-interactive-keywords (list (concat "^.*" regexp ".*$") (list 0 (list 'quote face) t))) (p-whim-lock-set-keywords)) (defalias 'highlight-regexp 'p-whim-lock-face-buffer) (defun p-whim-lock-face-buffer (regexp &optional face) "Set face of each match of REGEXP to FACE." (interactive (list (read-from-minibuffer "Regexp to highlight: " (cons (or (car p-whim-lock-regexp-history) "") 1 ) nil nil 'p-whim-lock-regexp-history) (intern (completing-read "Highlight using face: " obarray 'facep t (car p-whim-lock-face-history) '(p-whim-lock-face-history . 0))))) (if (or (not (stringp regexp)) (= (length regexp) 0)) (error "Invalid regexp")) (or (facep face) (setq face 'hi-yellow)) (if (not whim-lock-mode) (whim-lock-mode)) (add-to-list 'p-whim-lock-interactive-keywords (list regexp (list 0 (list 'quote face) t))) (p-whim-lock-set-keywords)) (defalias 'unhighlight-regexp 'p-whim-lock-unface-buffer) (defun p-whim-lock-unface-buffer (regexp) "Remove highlighting of each match to REGEXP set by whim-lock." (interactive (let ((history-list (mapcar (lambda (p) (car p)) p-whim-lock-interactive-keywords))) (list (completing-read "Regexp to unhighlight: " p-whim-lock-interactive-keywords t t (car (car p-whim-lock-interactive-keywords)) (cons 'history-list 1))))) (setq p-whim-lock-interactive-keywords (delq (assoc regexp p-whim-lock-interactive-keywords) p-whim-lock-interactive-keywords)) (p-whim-lock-set-keywords)) (defun p-whim-lock-write-interactive-patterns () "Write interactive patterns, if any, into buffer at point." (interactive) (mapcar (lambda (pattern) (insert (format "%s Whim-lock: (%s) %s\n" (or comment-start "") (prin1-to-string pattern) (or comment-end "")))) p-whim-lock-interactive-keywords)) (defun whim-lock-mode (&optional arg) "Toggle minor mode for adding per-buffer font-lock patterns. If ARG positive turn whim-lock on. \\[p-whim-lock-face-buffer] REGEXP FACE Highlight matches of REGEXP with FACE. \\[p-whim-lock-line-face-buffer] REGEXP FACE Highlight lines continain matches of REGEXP with FACE. \\[p-whim-lock-unface-buffer] REGEXP Remove highlighting on matches of REGEXP. \\[p-whim-lock-write-interactive-patterns] Write active REGEXPs into buffer as comments (if possible). They will be used next time file is loaded. \\[p-whim-lock-find-patterns] Re-read patterns stored in buffer (in format produced by \\[p-whim-lock-write-interactive-patterns]). When font lock started beginning of file searched for: Whim-lock: FOO where FOO is a list of patterns. These are added to the font lock keywords already present." (interactive) (let ((whim-lock-mode-prev whim-lock-mode)) (setq whim-lock-mode (if (null arg) (not whim-lock-mode) (> (prefix-numeric-value arg) 0))) ;; Turned on. (if (and (not whim-lock-mode-prev) whim-lock-mode) (progn (if (not font-lock-mode) (turn-on-font-lock)) (p-whim-lock-find-patterns))) ;; Turned off. (if (and whim-lock-mode-prev (not whim-lock-mode)) (progn ;; Keep keywords. (setq font-lock-keywords p-whim-lock-original-keywords) (p-whim-lock-refontify))))) (defun whim-lock-find-file-hook () "Turn on whim lock if patterns present." (p-whim-lock-find-patterns)) ;; Support Functions (defun p-current-line (&optional end) "Return line number of point or END, whichever is smaller." (interactive) (save-excursion (beginning-of-line) (1+ (count-lines 1 (or end (point)))))) ;; Implementation Functions (defun p-whim-lock-set-keywords (&optional reinit) "Add whim-lock's interactive and file keywords to font-lock keywords. Save font-lock's existing keywords if not already saved or if REINIT non-null." (if (or reinit (null p-whim-lock-original-keywords)) (setq p-whim-lock-original-keywords (or font-lock-keywords '(t)))) (setq font-lock-keywords (append (delq t p-whim-lock-original-keywords) p-whim-lock-file-keywords p-whim-lock-interactive-keywords)) (p-whim-lock-refontify)) (add-hook 'font-lock-mode-hook 'p-whim-lock-grab-keywords) (add-hook 'find-file-hooks 'whim-lock-find-file-hook) (defun p-whim-lock-grab-keywords () "If whim lock on, save font lock's keywords." (if whim-lock-mode (progn (p-whim-lock-set-keywords t)))) (defun p-whim-lock-refontify () "Unfontify and refontify buffer. Used when whim-lock patterns change." (interactive) (if (not font-lock-mode) (font-lock-mode)) (font-lock-unfontify-buffer) (cond ;; 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-conservatively (car windows)) (lazy-lock-fontify-window (car windows)) (setq windows (cdr windows))))) (t (font-lock-fontify-buffer)))) (defun p-whim-lock-find-patterns () "Find patterns in current buffer for whim lock." (interactive) (or (memq major-mode p-whim-lock-exclude-modes) (let ((all-patterns nil)) (save-excursion (widen) (goto-char (point-min)) (while (and (re-search-forward "\\