# HG changeset patch # User Kim F. Storm # Date 1079702157 0 # Node ID aabf30299e6cc264e32a5b088efa59eec2afea7b # Parent 43fc3aaf85fa50c2b7f6f90e4f130959156dc793 From David Ponce (ruler-mode-header-line-format-old): Don't `make-variable-buffer-local'. (ruler-mode-ruler-function): Default to `ruler-mode-ruler'. (ruler-mode-header-line-format): Simply funcall the above. (ruler-mode): Use `make-local-variable' and `kill-local-variable' to save/restore a previous header line format. (ruler-mode-space): Don't depend on a numeric WIDTH value. (ruler-mode-ruler): Use symbolic display elements for scrollbar, fringes and margins width. (ruler-mode-ruler-function): Default to ruler-mode-ruler diff -r 43fc3aaf85fa -r aabf30299e6c lisp/ruler-mode.el --- a/lisp/ruler-mode.el Fri Mar 19 10:40:46 2004 +0000 +++ b/lisp/ruler-mode.el Fri Mar 19 13:15:57 2004 +0000 @@ -1,6 +1,6 @@ ;;; ruler-mode.el --- display a ruler in the header line -;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: David Ponce ;; Maintainer: David Ponce @@ -95,7 +95,7 @@ ;; important to use the same font family and size for ruler and text ;; areas. ;; -;; You can override the ruler format by defining an appropriate +;; You can override the ruler format by defining an appropriate ;; function as the buffer-local value of `ruler-mode-ruler-function'. ;; Installation @@ -531,19 +531,15 @@ (defvar ruler-mode-header-line-format-old nil "Hold previous value of `header-line-format'.") -(make-variable-buffer-local 'ruler-mode-header-line-format-old) -(defvar ruler-mode-ruler-function nil - "If non-nil, function to call to return ruler string. +(defvar ruler-mode-ruler-function 'ruler-mode-ruler + "Function to call to return ruler header line format. This variable is expected to be made buffer-local by modes.") (defconst ruler-mode-header-line-format - '(:eval (funcall (if ruler-mode-ruler-function - ruler-mode-ruler-function - 'ruler-mode-ruler))) + '(:eval (funcall ruler-mode-ruler-function)) "`header-line-format' used in ruler mode. -If the non-nil value for ruler-mode-ruler-function is given, use it. -Else use `ruler-mode-ruler' is used as default value.") +Call `ruler-mode-ruler-function' to compute the ruler value.") ;;;###autoload (define-minor-mode ruler-mode @@ -556,18 +552,18 @@ ;; When `ruler-mode' is on save previous header line format ;; and install the ruler header line format. (when (local-variable-p 'header-line-format) - (setq ruler-mode-header-line-format-old header-line-format)) + (set (make-local-variable 'ruler-mode-header-line-format-old) + header-line-format)) (setq header-line-format ruler-mode-header-line-format) - (add-hook 'post-command-hook ; add local hook - #'force-mode-line-update nil t)) + (add-hook 'post-command-hook 'force-mode-line-update nil t)) ;; When `ruler-mode' is off restore previous header line format if ;; the current one is the ruler header line format. (when (eq header-line-format ruler-mode-header-line-format) (kill-local-variable 'header-line-format) (when (local-variable-p 'ruler-mode-header-line-format-old) - (setq header-line-format ruler-mode-header-line-format-old))) - (remove-hook 'post-command-hook ; remove local hook - #'force-mode-line-update t))) + (setq header-line-format ruler-mode-header-line-format-old) + (kill-local-variable 'ruler-mode-header-line-format-old))) + (remove-hook 'post-command-hook 'force-mode-line-update t))) ;; Add ruler-mode to the minor mode menu in the mode line (define-key mode-line-mode-menu [ruler-mode] @@ -621,133 +617,124 @@ (defsubst ruler-mode-space (width &rest props) "Return a single space string of WIDTH times the normal character width. Optional argument PROPS specifies other text properties to apply." - (if (> width 0) - (apply 'propertize " " 'display (list 'space :width width) props) - "")) + (apply 'propertize " " 'display (list 'space :width width) props)) (defun ruler-mode-ruler () - "Return a string ruler." - (when ruler-mode - (let* ((w (window-width)) - (m (window-margins)) - (lsb (scroll-bar-columns 'left)) - (lf (fringe-columns 'left t)) - (lm (or (car m) 0)) - (rsb (scroll-bar-columns 'right)) - (rf (fringe-columns 'right t)) - (rm (or (cdr m) 0)) - (ruler (make-string w ruler-mode-basic-graduation-char)) - (i 0) - (j (window-hscroll)) - k c l1 l2 r2 r1 h1 h2 f1 f2) - - ;; Setup the default properties. - (put-text-property 0 w 'face 'ruler-mode-default-face ruler) - (put-text-property 0 w - 'help-echo - (cond - (ruler-mode-show-tab-stops - ruler-mode-ruler-help-echo-when-tab-stops) - (goal-column - ruler-mode-ruler-help-echo-when-goal-column) - (t - ruler-mode-ruler-help-echo)) - ruler) - ;; Setup the local map. - (put-text-property 0 w 'local-map ruler-mode-map ruler) - - ;; Setup the active area. - (while (< i w) - ;; Graduations. - (cond - ;; Show a number graduation. - ((= (mod j 10) 0) - (setq c (number-to-string (/ j 10)) - m (length c) - k i) - (put-text-property - i (1+ i) 'face 'ruler-mode-column-number-face - ruler) - (while (and (> m 0) (>= k 0)) - (aset ruler k (aref c (setq m (1- m)))) - (setq k (1- k)))) - ;; Show an intermediate graduation. - ((= (mod j 5) 0) - (aset ruler i ruler-mode-inter-graduation-char))) - ;; Special columns. - (cond - ;; Show the `current-column' marker. - ((= j (current-column)) - (aset ruler i ruler-mode-current-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-current-column-face - ruler)) - ;; Show the `goal-column' marker. - ((and goal-column (= j goal-column)) - (aset ruler i ruler-mode-goal-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-goal-column-face - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-goal-column-help-echo - ruler)) - ;; Show the `comment-column' marker. - ((= j comment-column) - (aset ruler i ruler-mode-comment-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-comment-column-face - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-comment-column-help-echo - ruler)) - ;; Show the `fill-column' marker. - ((= j fill-column) - (aset ruler i ruler-mode-fill-column-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-fill-column-face - ruler) - (put-text-property - i (1+ i) 'help-echo ruler-mode-fill-column-help-echo - ruler)) - ;; Show the `tab-stop-list' markers. - ((and ruler-mode-show-tab-stops (member j tab-stop-list)) - (aset ruler i ruler-mode-tab-stop-char) - (put-text-property - i (1+ i) 'face 'ruler-mode-tab-stop-face - ruler))) - (setq i (1+ i) - j (1+ j))) - - ;; Highlight the fringes and margins. - (if (nth 2 (window-fringes)) - ;; fringes outside margins. - (setq l1 lf - l2 lm - r2 rm - r1 rf - h1 ruler-mode-fringe-help-echo - h2 ruler-mode-margin-help-echo - f1 'ruler-mode-fringes-face - f2 'ruler-mode-margins-face) - ;; fringes inside margins. - (setq l1 lm - l2 lf - r2 rf - r1 rm - h1 ruler-mode-margin-help-echo - h2 ruler-mode-fringe-help-echo - f1 'ruler-mode-margins-face - f2 'ruler-mode-fringes-face)) - ;; Return the ruler propertized string. Using list here, - ;; instead of concat visually separate the different areas. - (list - (ruler-mode-space lsb 'face 'ruler-mode-pad-face) - (ruler-mode-space l1 'face f1 'help-echo (format h1 "Left" l1)) - (ruler-mode-space l2 'face f2 'help-echo (format h2 "Left" l2)) - ruler - (ruler-mode-space r2 'face f2 'help-echo (format h2 "Right" r2)) - (ruler-mode-space r1 'face f1 'help-echo (format h1 "Right" r1)) - (ruler-mode-space rsb 'face 'ruler-mode-pad-face))))) + "Compute and return an header line ruler." + (let* ((w (window-width)) + (m (window-margins)) + (f (window-fringes)) + (i 0) + (j (window-hscroll)) + ;; Setup the scrollbar, fringes, and margins areas. + (lf (ruler-mode-space + 'left-fringe + 'face 'ruler-mode-fringes-face + 'help-echo (format ruler-mode-fringe-help-echo + "Left" (or (car f) 0)))) + (rf (ruler-mode-space + 'right-fringe + 'face 'ruler-mode-fringes-face + 'help-echo (format ruler-mode-fringe-help-echo + "Right" (or (cadr f) 0)))) + (lm (ruler-mode-space + 'left-margin + 'face 'ruler-mode-margins-face + 'help-echo (format ruler-mode-margin-help-echo + "Left" (or (car m) 0)))) + (rm (ruler-mode-space + 'right-margin + 'face 'ruler-mode-margins-face + 'help-echo (format ruler-mode-margin-help-echo + "Right" (or (cdr m) 0)))) + (sb (ruler-mode-space + 'scroll-bar + 'face 'ruler-mode-pad-face)) + ;; Remember the scrollbar vertical type. + (sbvt (car (window-current-scroll-bars))) + ;; Create an "clean" ruler. + (ruler + (propertize + (make-string w ruler-mode-basic-graduation-char) + 'face 'ruler-mode-default-face + 'local-map ruler-mode-map + 'help-echo (cond + (ruler-mode-show-tab-stops + ruler-mode-ruler-help-echo-when-tab-stops) + (goal-column + ruler-mode-ruler-help-echo-when-goal-column) + (ruler-mode-ruler-help-echo)))) + k c) + ;; Setup the active area. + (while (< i w) + ;; Graduations. + (cond + ;; Show a number graduation. + ((= (mod j 10) 0) + (setq c (number-to-string (/ j 10)) + m (length c) + k i) + (put-text-property + i (1+ i) 'face 'ruler-mode-column-number-face + ruler) + (while (and (> m 0) (>= k 0)) + (aset ruler k (aref c (setq m (1- m)))) + (setq k (1- k)))) + ;; Show an intermediate graduation. + ((= (mod j 5) 0) + (aset ruler i ruler-mode-inter-graduation-char))) + ;; Special columns. + (cond + ;; Show the `current-column' marker. + ((= j (current-column)) + (aset ruler i ruler-mode-current-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-current-column-face + ruler)) + ;; Show the `goal-column' marker. + ((and goal-column (= j goal-column)) + (aset ruler i ruler-mode-goal-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-goal-column-face + ruler) + (put-text-property + i (1+ i) 'help-echo ruler-mode-goal-column-help-echo + ruler)) + ;; Show the `comment-column' marker. + ((= j comment-column) + (aset ruler i ruler-mode-comment-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-comment-column-face + ruler) + (put-text-property + i (1+ i) 'help-echo ruler-mode-comment-column-help-echo + ruler)) + ;; Show the `fill-column' marker. + ((= j fill-column) + (aset ruler i ruler-mode-fill-column-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-fill-column-face + ruler) + (put-text-property + i (1+ i) 'help-echo ruler-mode-fill-column-help-echo + ruler)) + ;; Show the `tab-stop-list' markers. + ((and ruler-mode-show-tab-stops (member j tab-stop-list)) + (aset ruler i ruler-mode-tab-stop-char) + (put-text-property + i (1+ i) 'face 'ruler-mode-tab-stop-face + ruler))) + (setq i (1+ i) + j (1+ j))) + ;; Return the ruler propertized string. Using list here, + ;; instead of concat visually separate the different areas. + (if (nth 2 (window-fringes)) + ;; fringes outside margins. + (list "" (and (eq 'left sbvt) sb) lf lm + ruler rm rf (and (eq 'right sbvt) sb)) + ;; fringes inside margins. + (list "" (and (eq 'left sbvt) sb) lm lf + ruler rf rm (and (eq 'right sbvt) sb))))) (provide 'ruler-mode)