Mercurial > emacs

changeset 54440:aabf30299e6c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
From David Ponce <david@dponce.com> (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
author Kim F. Storm <storm@cua.dk>
date Fri, 19 Mar 2004 13:15:57 +0000
parents 43fc3aaf85fa
children 81368dcb68dd
files lisp/ruler-mode.el
diffstat 1 files changed, 128 insertions(+), 141 deletions(-) [+]
line wrap: on
line diff
--- 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 <david@dponce.com>
 ;; Maintainer: David Ponce <david@dponce.com>
@@ -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)