1 ;;; ruler-mode.el --- Display a ruler in the header line
3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
5 ;; Author: David Ponce <david@dponce.com>
6 ;; Maintainer: David Ponce <david@dponce.com>
7 ;; Created: 24 Mar 2001
9 ;; Keywords: environment
11 ;; This file is part of GNU Emacs.
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program; see the file COPYING. If not, write to
25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
30 ;; This library provides a minor mode to display a ruler in the header
31 ;; line. It works only on Emacs 21.
33 ;; You can use the mouse to change the `fill-column', `window-margins'
34 ;; and `tab-stop-list' settings:
36 ;; [header-line (shift down-mouse-1)] set left margin to the ruler
37 ;; graduation where the mouse pointer is on.
39 ;; [header-line (shift down-mouse-3)] set right margin to the ruler
40 ;; graduation where the mouse pointer is on.
42 ;; [header-line down-mouse-2] set `fill-column' to the ruler
43 ;; graduation where the mouse pointer is on.
45 ;; [header-line (control down-mouse-1)] add a tab stop to the ruler
46 ;; graduation where the mouse pointer is on.
48 ;; [header-line (control down-mouse-3)] remove the tab stop at the
49 ;; ruler graduation where the mouse pointer is on.
51 ;; [header-line (control down-mouse-2)] or M-x
52 ;; `ruler-mode-toggle-show-tab-stops' toggle showing and visually
53 ;; editing `tab-stop-list' setting. The `ruler-mode-show-tab-stops'
54 ;; option controls if the ruler shows tab stops by default.
56 ;; In the ruler the character `ruler-mode-current-column-char' shows
57 ;; the `current-column' location, `ruler-mode-fill-column-char' shows
58 ;; the `fill-column' location and `ruler-mode-tab-stop-char' shows tab
59 ;; stop locations. `window-margins' areas are shown with a different
62 ;; It is also possible to customize the following characters:
64 ;; - `ruler-mode-margins-char' character used to pad margin areas
65 ;; (space by default).
66 ;; - `ruler-mode-basic-graduation-char' character used for basic
67 ;; graduations ('.' by default).
68 ;; - `ruler-mode-inter-graduation-char' character used for
69 ;; intermediate graduations ('!' by default).
71 ;; The following faces are customizable:
73 ;; - `ruler-mode-default-face' the ruler default face.
74 ;; - `ruler-mode-fill-column-face' the face used to highlight the
75 ;; `fill-column' character.
76 ;; - `ruler-mode-current-column-face' the face used to highlight the
77 ;; `current-column' character.
78 ;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
80 ;; - `ruler-mode-margins-face' the face used to highlight the
81 ;; `window-margins' areas.
82 ;; - `ruler-mode-column-number-face' the face used to highlight the
83 ;; number graduations.
85 ;; `ruler-mode-default-face' inherits from the built-in `default' face.
86 ;; All `ruler-mode' faces inerit from `ruler-mode-default-face'.
88 ;; WARNING: To keep ruler graduations aligned on text columns it is
89 ;; important to use the same font family and size for ruler and text
94 ;; To automatically display the ruler in specific major modes use:
96 ;; (add-hook '<major-mode>-hook 'ruler-mode)
106 (defgroup ruler-mode nil
107 "Display a ruler in the header line."
111 (defcustom ruler-mode-show-tab-stops nil
112 "*If non-nil the ruler shows tab stop positions.
113 Also allowing to visually change `tab-stop-list' setting using
114 <C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
115 or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
116 <C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
120 ;; IMPORTANT: This function must be defined before the following
121 ;; defcustoms because it is used in their :validate clause.
122 (defun ruler-mode-character-validate (widget)
123 "Ensure WIDGET value is a valid character value."
125 (let ((value (widget-value widget)))
126 (if (char-valid-p value)
128 (widget-put widget :error
129 (format "Invalid character value: %S" value))
132 (defcustom ruler-mode-fill-column-char (if window-system
135 "*Character used at the `fill-column' location."
138 (character :tag "Character")
139 (integer :tag "Integer char value"
140 :validate ruler-mode-character-validate)))
142 (defcustom ruler-mode-current-column-char (if window-system
145 "*Character used at the `current-column' location."
148 (character :tag "Character")
149 (integer :tag "Integer char value"
150 :validate ruler-mode-character-validate)))
152 (defcustom ruler-mode-tab-stop-char ?\T
153 "*Character used at `tab-stop-list' locations."
156 (character :tag "Character")
157 (integer :tag "Integer char value"
158 :validate ruler-mode-character-validate)))
160 (defcustom ruler-mode-margins-char ?\
161 "*Character used in margin areas."
164 (character :tag "Character")
165 (integer :tag "Integer char value"
166 :validate ruler-mode-character-validate)))
168 (defcustom ruler-mode-basic-graduation-char ?\.
169 "*Character used for basic graduations."
172 (character :tag "Character")
173 (integer :tag "Integer char value"
174 :validate ruler-mode-character-validate)))
176 (defcustom ruler-mode-inter-graduation-char ?\!
177 "*Character used for intermediate graduations."
180 (character :tag "Character")
181 (integer :tag "Integer char value"
182 :validate ruler-mode-character-validate)))
184 (defface ruler-mode-default-face
194 :box (:color "grey76"
196 :style released-button)
198 "Default face used by the ruler."
201 (defface ruler-mode-column-number-face
203 (:inherit ruler-mode-default-face
206 "Face used to highlight number graduations."
209 (defface ruler-mode-fill-column-face
211 (:inherit ruler-mode-default-face
214 "Face used to highlight the fill column character."
217 (defface ruler-mode-tab-stop-face
219 (:inherit ruler-mode-default-face
220 :foreground "steelblue"
222 "Face used to highlight tab stop characters."
225 (defface ruler-mode-margins-face
227 (:inherit ruler-mode-default-face
231 (:inherit ruler-mode-default-face
234 "Face used to highlight the `window-margins' areas."
237 (defface ruler-mode-current-column-face
239 (:inherit ruler-mode-default-face
243 "Face used to highlight the `current-column' character."
246 (defun ruler-mode-mouse-set-left-margin (start-event)
247 "Set left margin to the graduation where the mouse pointer is on.
248 START-EVENT is the mouse click event."
250 (let* ((start (event-start start-event))
251 (end (event-end start-event))
253 (if (eq start end) ;; mouse click
254 (save-selected-window
255 (select-window (posn-window start))
256 (setq m (window-margins)
260 col (car (posn-col-row start))
261 lm (min (- w rm) col))
262 (message "Left margin set to %d (was %d)" lm lm0)
263 (set-window-margins nil lm rm)))))
265 (defun ruler-mode-mouse-set-right-margin (start-event)
266 "Set right margin to the graduation where the mouse pointer is on.
267 START-EVENT is the mouse click event."
269 (let* ((start (event-start start-event))
270 (end (event-end start-event))
272 (if (eq start end) ;; mouse click
273 (save-selected-window
274 (select-window (posn-window start))
275 (setq m (window-margins)
278 col (car (posn-col-row start))
280 rm (max 0 (- w col)))
281 (message "Right margin set to %d (was %d)" rm rm0)
282 (set-window-margins nil lm rm)))))
284 (defun ruler-mode-mouse-set-fill-column (start-event)
285 "Set `fill-column' to the graduation where the mouse pointer is on.
286 START-EVENT is the mouse click event."
288 (let* ((start (event-start start-event))
289 (end (event-end start-event))
291 (if (eq start end) ;; mouse click
292 (save-selected-window
293 (select-window (posn-window start))
294 (setq m (window-margins)
297 col (- (car (posn-col-row start)) lm)
301 (and (>= col 0) (< (+ col lm rm) w)
303 (message "Fill column set to %d (was %d)" fc fill-column)
304 (setq fill-column fc)))))))
306 (defun ruler-mode-mouse-add-tab-stop (start-event)
307 "Add a tab stop to the graduation where the mouse pointer is on.
308 START-EVENT is the mouse click event."
310 (if ruler-mode-show-tab-stops
311 (let* ((start (event-start start-event))
312 (end (event-end start-event))
314 (if (eq start end) ;; mouse click
315 (save-selected-window
316 (select-window (posn-window start))
317 (setq m (window-margins)
320 col (- (car (posn-col-row start)) lm)
324 (and (>= col 0) (< (+ col lm rm) w)
325 (not (member ts tab-stop-list))
327 (message "Tab stop set to %d" ts)
329 (sort (cons ts tab-stop-list)
332 (defun ruler-mode-mouse-del-tab-stop (start-event)
333 "Delete tab stop at the graduation where the mouse pointer is on.
334 START-EVENT is the mouse click event."
336 (if ruler-mode-show-tab-stops
337 (let* ((start (event-start start-event))
338 (end (event-end start-event))
340 (if (eq start end) ;; mouse click
341 (save-selected-window
342 (select-window (posn-window start))
343 (setq m (window-margins)
346 col (- (car (posn-col-row start)) lm)
350 (and (>= col 0) (< (+ col lm rm) w)
351 (member ts tab-stop-list)
353 (message "Tab stop at %d deleted" ts)
355 (delete ts tab-stop-list)))))))))
357 (defun ruler-mode-toggle-show-tab-stops ()
358 "Toggle showing of tab stops on the ruler."
360 (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
361 (force-mode-line-update))
363 (defvar ruler-mode-map
364 (let ((km (make-sparse-keymap)))
365 (define-key km [header-line down-mouse-1]
367 (define-key km [header-line down-mouse-3]
369 (define-key km [header-line down-mouse-2]
370 #'ruler-mode-mouse-set-fill-column)
371 (define-key km [header-line (shift down-mouse-1)]
372 #'ruler-mode-mouse-set-left-margin)
373 (define-key km [header-line (shift down-mouse-3)]
374 #'ruler-mode-mouse-set-right-margin)
375 (define-key km [header-line (control down-mouse-1)]
376 #'ruler-mode-mouse-add-tab-stop)
377 (define-key km [header-line (control down-mouse-3)]
378 #'ruler-mode-mouse-del-tab-stop)
379 (define-key km [header-line (control down-mouse-2)]
380 #'ruler-mode-toggle-show-tab-stops)
382 "Keymap for ruler minor mode.")
384 (defvar ruler-mode-header-line-format-old nil
385 "Hold previous value of `header-line-format'.")
386 (make-variable-buffer-local 'ruler-mode-header-line-format-old)
388 (defconst ruler-mode-header-line-format
389 '(:eval (ruler-mode-ruler))
390 "`header-line-format' used in ruler mode.")
393 (define-minor-mode ruler-mode
394 "Display a ruler in the header line if ARG > 0."
400 ;; When `ruler-mode' is on save previous header line format
401 ;; and install the ruler header line format.
402 (setq ruler-mode-header-line-format-old header-line-format
403 header-line-format ruler-mode-header-line-format)
404 (add-hook 'post-command-hook ; add local hook
405 #'force-mode-line-update nil t))
406 ;; When `ruler-mode' is off restore previous header line format if
407 ;; the current one is the ruler header line format.
408 (if (eq header-line-format ruler-mode-header-line-format)
409 (setq header-line-format ruler-mode-header-line-format-old))
410 (remove-hook 'post-command-hook ; remove local hook
411 #'force-mode-line-update t)))
413 ;; Add ruler-mode to the the minor mode menu in the mode line
414 (define-key mode-line-mode-menu [ruler-mode]
415 `(menu-item "Ruler" ruler-mode
416 :button (:toggle . ruler-mode)))
418 (defconst ruler-mode-ruler-help-echo
420 S-mouse-1/3: set L/R margin, \
421 mouse-2: set fill col, \
422 C-mouse-2: show tabs"
423 "Help string shown when mouse pointer is over the ruler.
424 `ruler-mode-show-tab-stops' is nil.")
426 (defconst ruler-mode-ruler-help-echo-tab
428 C-mouse1/3: set/unset tab, \
429 C-mouse-2: hide tabs"
430 "Help string shown when mouse pointer is over the ruler.
431 `ruler-mode-show-tab-stops' is non-nil.")
433 (defconst ruler-mode-left-margin-help-echo
435 "Help string shown when mouse is over the left margin area.")
437 (defconst ruler-mode-right-margin-help-echo
439 "Help string shown when mouse is over the right margin area.")
441 (defmacro ruler-mode-left-fringe-cols ()
442 "Return the width, measured in columns, of the left fringe area."
443 '(round (or (frame-parameter nil 'left-fringe) 0)
446 (defmacro ruler-mode-right-fringe-cols ()
447 "Return the width, measured in columns, of the right fringe area."
448 '(round (or (frame-parameter nil 'right-fringe) 0)
451 (defmacro ruler-mode-left-scroll-bar-cols ()
452 "Return the width, measured in columns, of the left vertical scrollbar."
453 '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'left)
454 (round (or (frame-parameter nil 'scroll-bar-width) 0)
458 (defmacro ruler-mode-right-scroll-bar-cols ()
459 "Return the width, measured in columns, of the right vertical scrollbar."
460 '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'right)
461 (round (or (frame-parameter nil 'scroll-bar-width) 0)
465 (defun ruler-mode-ruler ()
466 "Return a string ruler."
468 (let* ((j (+ (ruler-mode-left-fringe-cols)
469 (ruler-mode-left-scroll-bar-cols)))
470 (w (+ (window-width) j))
474 (o (- (window-hscroll) l j))
478 (make-string w ruler-mode-basic-graduation-char)
479 ;; extra space to fill the header line
480 (make-string (+ (ruler-mode-right-fringe-cols)
481 (ruler-mode-right-scroll-bar-cols))
485 ;; Setup default face and help echo.
486 (put-text-property 0 (length ruler)
487 'face 'ruler-mode-default-face
489 (put-text-property 0 (length ruler)
491 (if ruler-mode-show-tab-stops
492 ruler-mode-ruler-help-echo-tab
493 ruler-mode-ruler-help-echo)
495 ;; Setup the local map.
496 (put-text-property 0 (length ruler)
497 'local-map ruler-mode-map
501 ;; Setup the left margin area.
503 i j 'face 'ruler-mode-margins-face
506 i j 'help-echo (format ruler-mode-left-margin-help-echo l)
509 (aset ruler i ruler-mode-margins-char)
512 ;; Setup the ruler area.
518 (setq c (number-to-string (/ j 10))
522 i (1+ i) 'face 'ruler-mode-column-number-face
524 (while (and (> m 0) (>= k 0))
525 (aset ruler k (aref c (setq m (1- m))))
529 (aset ruler i ruler-mode-inter-graduation-char)
534 ;; Setup the right margin area.
536 i (length ruler) 'face 'ruler-mode-margins-face
539 i (length ruler) 'help-echo
540 (format ruler-mode-right-margin-help-echo (- w r))
542 (while (< i (length ruler))
543 (aset ruler i ruler-mode-margins-char)
546 ;; Show the `fill-column' marker.
547 (setq i (- fill-column o))
548 (and (>= i 0) (< i r)
549 (aset ruler i ruler-mode-fill-column-char)
551 i (1+ i) 'face 'ruler-mode-fill-column-face
554 ;; Show the `tab-stop-list' markers.
555 (if ruler-mode-show-tab-stops
556 (let ((tsl tab-stop-list) ts)
561 (and (>= i 0) (< i r)
562 (aset ruler i ruler-mode-tab-stop-char)
566 ;; Don't override the fill-column face
568 'ruler-mode-fill-column-face)
570 'ruler-mode-tab-stop-face))
573 ;; Show the `current-column' marker.
574 (setq i (- (current-column) o))
575 (and (>= i 0) (< i r)
576 (aset ruler i ruler-mode-current-column-char)
578 i (1+ i) 'face 'ruler-mode-current-column-face
583 (provide 'ruler-mode)
586 ;; coding: iso-latin-1
589 ;;; ruler-mode.el ends here