diff options
Diffstat (limited to 'lisp/ruler-mode.el')
| -rw-r--r-- | lisp/ruler-mode.el | 348 |
1 files changed, 150 insertions, 198 deletions
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index e8568a8d68b..a7cdc327e85 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -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> @@ -94,6 +94,9 @@ ;; WARNING: To keep ruler graduations aligned on text columns it is ;; important to use the same font family and size for ruler and text ;; areas. +;; +;; You can override the ruler format by defining an appropriate +;; function as the buffer-local value of `ruler-mode-ruler-function'. ;; Installation ;; @@ -108,6 +111,8 @@ ;;; Code: (eval-when-compile (require 'wid-edit)) +(require 'scroll-bar) +(require 'fringe) (defgroup ruler-mode nil "Display a ruler in the header line." @@ -134,7 +139,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (format "Invalid character value: %S" value)) widget)))) -(defcustom ruler-mode-fill-column-char (if window-system +(defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶) ?\¶ ?\|) "*Character used at the `fill-column' location." @@ -160,7 +165,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (integer :tag "Integer char value" :validate ruler-mode-character-validate))) -(defcustom ruler-mode-current-column-char (if window-system +(defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦) ?\¦ ?\@) "*Character used at the `current-column' location." @@ -293,49 +298,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or "Face used to highlight the `current-column' character." :group 'ruler-mode) -(defmacro ruler-mode-left-fringe-cols () - "Return the width, measured in columns, of the left fringe area." - '(ceiling (or (car (window-fringes)) 0) - (frame-char-width))) - -(defmacro ruler-mode-right-fringe-cols () - "Return the width, measured in columns, of the right fringe area." - '(ceiling (or (nth 1 (window-fringes)) 0) - (frame-char-width))) - -(defun ruler-mode-left-scroll-bar-cols () - "Return the width, measured in columns, of the right vertical scrollbar." - (let* ((wsb (window-scroll-bars)) - (vtype (nth 2 wsb)) - (cols (nth 1 wsb))) - (if (or (eq vtype 'left) - (and (eq vtype t) - (eq (frame-parameter nil 'vertical-scroll-bars) 'left))) - (or cols - (ceiling - ;; nil means it's a non-toolkit scroll bar, - ;; and its width in columns is 14 pixels rounded up. - (or (frame-parameter nil 'scroll-bar-width) 14) - ;; Always round up to multiple of columns. - (frame-char-width))) - 0))) - -(defun ruler-mode-right-scroll-bar-cols () - "Return the width, measured in columns, of the right vertical scrollbar." - (let* ((wsb (window-scroll-bars)) - (vtype (nth 2 wsb)) - (cols (nth 1 wsb))) - (if (or (eq vtype 'right) - (and (eq vtype t) - (eq (frame-parameter nil 'vertical-scroll-bars) 'right))) - (or cols - (ceiling - ;; nil means it's a non-toolkit scroll bar, - ;; and its width in columns is 14 pixels rounded up. - (or (frame-parameter nil 'scroll-bar-width) 14) - ;; Always round up to multiple of columns. - (frame-char-width))) - 0))) (defsubst ruler-mode-full-window-width () "Return the full width of the selected window." @@ -348,8 +310,8 @@ N is a column number relative to selected frame." (- n (car (window-edges)) (or (car (window-margins)) 0) - (ruler-mode-left-fringe-cols) - (ruler-mode-left-scroll-bar-cols))) + (fringe-columns 'left) + (scroll-bar-columns 'left))) (defun ruler-mode-mouse-set-left-margin (start-event) "Set left margin end to the graduation where the mouse pointer is on. @@ -362,10 +324,10 @@ START-EVENT is the mouse click event." (save-selected-window (select-window (posn-window start)) (setq col (- (car (posn-col-row start)) (car (window-edges)) - (ruler-mode-left-scroll-bar-cols)) + (scroll-bar-columns 'left)) w (- (ruler-mode-full-window-width) - (ruler-mode-left-scroll-bar-cols) - (ruler-mode-right-scroll-bar-cols))) + (scroll-bar-columns 'left) + (scroll-bar-columns 'right))) (when (and (>= col 0) (< col w)) (setq lm (window-margins) rm (or (cdr lm) 0) @@ -384,10 +346,10 @@ START-EVENT is the mouse click event." (save-selected-window (select-window (posn-window start)) (setq col (- (car (posn-col-row start)) (car (window-edges)) - (ruler-mode-left-scroll-bar-cols)) + (scroll-bar-columns 'left)) w (- (ruler-mode-full-window-width) - (ruler-mode-left-scroll-bar-cols) - (ruler-mode-right-scroll-bar-cols))) + (scroll-bar-columns 'left) + (scroll-bar-columns 'right))) (when (and (>= col 0) (< col w)) (setq lm (window-margins) rm (or (cdr lm) 0) @@ -568,11 +530,15 @@ START-EVENT is the mouse click event." (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 '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 (ruler-mode-ruler)) - "`header-line-format' used in ruler mode.") + '(:eval (funcall ruler-mode-ruler-function)) + "`header-line-format' used in ruler mode. +Call `ruler-mode-ruler-function' to compute the ruler value.") ;;;###autoload (define-minor-mode ruler-mode @@ -585,18 +551,18 @@ START-EVENT is the mouse click event." ;; 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] @@ -646,143 +612,128 @@ mouse-2: unset goal column" (defconst ruler-mode-fringe-help-echo "%s fringe %S" "Help string shown when mouse is over a fringe area.") + +(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." + (apply 'propertize " " 'display (list 'space :width width) props)) (defun ruler-mode-ruler () - "Return a string ruler." - (when ruler-mode - (let* ((fullw (ruler-mode-full-window-width)) - (w (window-width)) - (m (window-margins)) - (lsb (ruler-mode-left-scroll-bar-cols)) - (lf (ruler-mode-left-fringe-cols)) - (lm (or (car m) 0)) - (rsb (ruler-mode-right-scroll-bar-cols)) - (rf (ruler-mode-right-fringe-cols)) - (rm (or (cdr m) 0)) - (ruler (make-string fullw ruler-mode-basic-graduation-char)) - (o (+ lsb lf lm)) - (x 0) - (i o) - (j (window-hscroll)) - k c l1 l2 r2 r1 h1 h2 f1 f2) - - ;; Setup the default properties. - (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler) - (put-text-property 0 fullw - '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 fullw 'local-map ruler-mode-map ruler) - - ;; Setup the active area. - (while (< x 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) - x (1+ x))) - - ;; 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)) - (setq i lsb j (+ i l1)) - (put-text-property i j 'face f1 ruler) - (put-text-property i j 'help-echo (format h1 "Left" l1) ruler) - (setq i j j (+ i l2)) - (put-text-property i j 'face f2 ruler) - (put-text-property i j 'help-echo (format h2 "Left" l2) ruler) - (setq i (+ o w) j (+ i r2)) - (put-text-property i j 'face f2 ruler) - (put-text-property i j 'help-echo (format h2 "Right" r2) ruler) - (setq i j j (+ i r1)) - (put-text-property i j 'face f1 ruler) - (put-text-property i j 'help-echo (format h1 "Right" r1) ruler) - - ;; Show inactive areas. - (put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler) - (put-text-property j fullw 'face 'ruler-mode-pad-face ruler) - - ;; Return the ruler propertized string. - ruler))) + "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) @@ -790,4 +741,5 @@ mouse-2: unset goal column" ;; coding: iso-latin-1 ;; End: +;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8 ;;; ruler-mode.el ends here |