;;; color-mode.el --- minor mode for colorizing lines of a file ;; Don Knuth, August 2000 ;; (I use this for files that inventory my library and preprints etc.) ;; When using this mode you can colorize the current line with various ;; colors called color-@, color-a, color-b, etc., by saying ;; "C-c@", "C-ca", "C-cb", etc. And C-c DEL will uncolorize a colorized line. ;; (The Emacs Lisp Reference Manual says that minor modes should not ;; bind these keys --- they are "reserved for users" --- but it offers no ;; decent alternatives. The "c" in "C-c" stands for "color", so I'm using it.) ;; The colors are defined below. I could of course make them ;; more customizable, but since I'm the only user I didn't bother. ;; The stored file begins with "Color-Mode\n" and has ^@ or ^A or ^B ;; or ... at the beginning of each colorized line. The displayed file ;; uses the conventions of format.el in a simple way, sort of like a very ;; impoverished kind of enriched text. ;; I wrote and tested this with Emacs 20.4. It may fail with other versions. ;; It should be possible to use color mode together with enriched mode, ;; at least in simple files that don't depend on justification. ;; But you can't do that with Emacs 20.4 because of a bug in write-region ;; that I have just reported to GNU. (make-empty-face 'color-mode-face-@) (make-empty-face 'color-mode-face-a) (make-empty-face 'color-mode-face-b) (make-empty-face 'color-mode-face-c) (make-empty-face 'color-mode-face-d) (make-empty-face 'color-mode-face-e) (make-empty-face 'color-mode-face-f) (make-empty-face 'color-mode-face-g) (make-empty-face 'color-mode-face-h) ;; params here are: foreground background stipple bold ital underline inverse (modify-face 'color-mode-face-@ nil "darkolivegreen" nil nil nil nil nil) (modify-face 'color-mode-face-a "green" nil nil nil nil nil nil) (modify-face 'color-mode-face-b "orange" nil nil nil nil nil nil) (modify-face 'color-mode-face-c "red" nil nil nil nil nil nil) (modify-face 'color-mode-face-d "violet" nil nil nil nil nil nil) (modify-face 'color-mode-face-e "lightblue" nil nil nil nil nil nil) (modify-face 'color-mode-face-f "blue" "orange" nil nil nil nil nil) (modify-face 'color-mode-face-g "brown" "white" nil nil nil t nil) (modify-face 'color-mode-face-h "black" "brown" nil nil nil t nil) (defconst color-mode-faces '(color-mode-face-@ color-mode-face-a color-mode-face-b color-mode-face-c color-mode-face-d color-mode-face-e color-mode-face-f color-mode-face-g color-mode-face-h) "List of the faces available in color mode.") (defvar color-mode nil "True if Color mode is in use.") (make-variable-buffer-local 'color-mode) (put 'color-mode 'permanent-local t) ;; preserve color across major mode change (setq-default color-mode nil) (or (assq 'color-mode minor-mode-alist) (setq minor-mode-alist (cons '(color-mode " Color") minor-mode-alist))) (defvar color-mode-map nil "Keymap for Color Mode.") (if (null color-mode-map) (fset 'color-mode-map (setq color-mode-map (make-sparse-keymap)))) (if (not (assq 'color-mode minor-mode-map-alist)) (setq minor-mode-map-alist (cons (cons 'color-mode color-mode-map) minor-mode-map-alist))) (define-key color-mode-map "\C-c@" 'color-mode-paint-line-with-color-@) (define-key color-mode-map "\C-ca" 'color-mode-paint-line-with-color-a) (define-key color-mode-map "\C-cb" 'color-mode-paint-line-with-color-b) (define-key color-mode-map "\C-cc" 'color-mode-paint-line-with-color-c) (define-key color-mode-map "\C-cd" 'color-mode-paint-line-with-color-d) (define-key color-mode-map "\C-ce" 'color-mode-paint-line-with-color-e) (define-key color-mode-map "\C-cf" 'color-mode-paint-line-with-color-f) (define-key color-mode-map "\C-cg" 'color-mode-paint-line-with-color-g) (define-key color-mode-map "\C-ch" 'color-mode-paint-line-with-color-h) (define-key color-mode-map "\C-c\C-?" 'color-mode-unpaint-line) (setq format-alist (cons '(colormode "Color-Mode format" "Color-Mode\n" color-decode color-encode t color-mode) format-alist)) (defun color-mode-paint-line-with-color-@ () (interactive)(color-mode-paint-line 0)) (defun color-mode-paint-line-with-color-a () (interactive)(color-mode-paint-line 1)) (defun color-mode-paint-line-with-color-b () (interactive)(color-mode-paint-line 2)) (defun color-mode-paint-line-with-color-c () (interactive)(color-mode-paint-line 3)) (defun color-mode-paint-line-with-color-d () (interactive)(color-mode-paint-line 4)) (defun color-mode-paint-line-with-color-e () (interactive)(color-mode-paint-line 5)) (defun color-mode-paint-line-with-color-f () (interactive)(color-mode-paint-line 6)) (defun color-mode-paint-line-with-color-g () (interactive)(color-mode-paint-line 7)) (defun color-mode-paint-line-with-color-h () (interactive)(color-mode-paint-line 8)) ;; In color mode the normal stickiness conventions are reversed, because ;; we want to type at the beginning of a colorized line and inherit the ;; color of that line. Similarly, we want to type at the beginning of ;; a non-colorized line without inheriting the color of the newline ;; that ends the previous line. (I want the newline character to be ;; colorized, so that painting always extends to the right margin.) ;; The newline is made rear-nonsticky. All characters of a painted line ;; are made front-sticky; I don't want to do this just to the first character, ;; because the user can delete it. ;; If this mode is going to be used seriously in connection with other modes, ;; I could be more careful to confine the stickiness switching to the ;; text properties I control and not to any other attributes. But the ;; design of Emacs Lisp makes that rather painful, so I simply set ;; front-sticky and rear-nonsticky to `t' in this version of the code. ;; I'll let other people hack more generality into the routine if they ;; think it is worth their time. (defun color-mode-paint-line (n) "Displays the current line using the nth face of color-mode-faces." (save-excursion (let (beg end) (beginning-of-line 1) (setq beg (point)) (beginning-of-line 2) (setq end (point)) (put-text-property beg end 'face (nth n color-mode-faces)) (put-text-property beg end 'color-mode n) (put-text-property beg end 'front-sticky t) (put-text-property (1- end) end 'rear-nonsticky t)))) (defun color-mode-unpaint-line () "Removes the color-mode face, if any, associated with the current line." (interactive) (save-excursion (let (beg end) (beginning-of-line 1) (setq beg (point)) (if (get-text-property beg 'color-mode) (progn (beginning-of-line 2) (setq end (point)) (remove-text-properties beg end '(face nil color-mode nil)) (remove-text-properties beg (1+ beg) '(front-sticky nil)) (remove-text-properties (1- end) end '(rear-nonsticky nil))))))) (defun color-mode (&optional arg) "Minor mode for editing colorized files. \\\\{color-mode-map}" (interactive "P") (let ((mod (buffer-modified-p))) (cond ((or (<= (prefix-numeric-value arg) 0) (and color-mode (null arg))) (setq color-mode nil) ;;; negative arg turns mode off (setq buffer-file-format (delq 'colormode buffer-file-format))) (color-mode nil) ;;; if already on, we don't do anything (t (setq color-mode t) ;;; otherwise turn it on (add-to-list 'buffer-file-format 'colormode))) (set-buffer-modified-p mod) (force-mode-line-update))) (defun color-decode (from to) (let ((save-undos buffer-undo-list)) (setq buffer-undo-list t) (save-restriction (narrow-to-region from to) (goto-char from) (delete-char 11) ;; delete "Color-Mode\n" (while (not (eobp)) (let ((ch (following-char))) (if (< ch 9) ;; test if first char of line is ^@, ^A, ... or ^H (progn (delete-char 1) (color-mode-paint-line ch))) (next-line 1))) (setq buffer-undo-list save-undos) (point-max)))) (defun color-encode (from to orig-buf) (save-restriction (narrow-to-region from to) (goto-char from) (insert "Color-Mode\n") (while (not (eobp)) (let* ((pos (point)) (ch (get-text-property pos 'color-mode))) (while ch (if (= (char-before pos) ?\n) (insert ch)) (beginning-of-line 2) (setq pos (point) ch (get-text-property pos 'color-mode))) (goto-char (or (next-single-property-change pos 'color-mode) (point-max))))) (point-max)))