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 convenience
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 (unless (characterp value
)
127 (widget-put widget
:error
128 (format "Invalid character value: %S" value
))
131 (defcustom ruler-mode-fill-column-char
(if window-system
134 "*Character used at the `fill-column' location."
137 (character :tag
"Character")
138 (integer :tag
"Integer char value"
139 :validate ruler-mode-character-validate
)))
141 (defcustom ruler-mode-current-column-char
(if window-system
144 "*Character used at the `current-column' location."
147 (character :tag
"Character")
148 (integer :tag
"Integer char value"
149 :validate ruler-mode-character-validate
)))
151 (defcustom ruler-mode-tab-stop-char ?\T
152 "*Character used at `tab-stop-list' locations."
155 (character :tag
"Character")
156 (integer :tag
"Integer char value"
157 :validate ruler-mode-character-validate
)))
159 (defcustom ruler-mode-margins-char ?\
160 "*Character used in margin areas."
163 (character :tag
"Character")
164 (integer :tag
"Integer char value"
165 :validate ruler-mode-character-validate
)))
167 (defcustom ruler-mode-basic-graduation-char ?\.
168 "*Character used for basic graduations."
171 (character :tag
"Character")
172 (integer :tag
"Integer char value"
173 :validate ruler-mode-character-validate
)))
175 (defcustom ruler-mode-inter-graduation-char ?\
!
176 "*Character used for intermediate graduations."
179 (character :tag
"Character")
180 (integer :tag
"Integer char value"
181 :validate ruler-mode-character-validate
)))
183 (defface ruler-mode-default-face
193 :box
(:color
"grey76"
195 :style released-button
)
197 "Default face used by the ruler."
200 (defface ruler-mode-column-number-face
202 (:inherit ruler-mode-default-face
205 "Face used to highlight number graduations."
208 (defface ruler-mode-fill-column-face
210 (:inherit ruler-mode-default-face
213 "Face used to highlight the fill column character."
216 (defface ruler-mode-tab-stop-face
218 (:inherit ruler-mode-default-face
219 :foreground
"steelblue"
221 "Face used to highlight tab stop characters."
224 (defface ruler-mode-margins-face
226 (:inherit ruler-mode-default-face
230 (:inherit ruler-mode-default-face
233 "Face used to highlight the `window-margins' areas."
236 (defface ruler-mode-current-column-face
238 (:inherit ruler-mode-default-face
242 "Face used to highlight the `current-column' character."
245 (defun ruler-mode-mouse-set-left-margin (start-event)
246 "Set left margin to the graduation where the mouse pointer is on.
247 START-EVENT is the mouse click event."
249 (let* ((start (event-start start-event
))
250 (end (event-end start-event
))
252 (if (eq start end
) ;; mouse click
253 (save-selected-window
254 (select-window (posn-window start
))
255 (setq m
(window-margins)
259 col
(car (posn-col-row start
))
260 lm
(min (- w rm
) col
))
261 (message "Left margin set to %d (was %d)" lm lm0
)
262 (set-window-margins nil lm rm
)))))
264 (defun ruler-mode-mouse-set-right-margin (start-event)
265 "Set right margin to the graduation where the mouse pointer is on.
266 START-EVENT is the mouse click event."
268 (let* ((start (event-start start-event
))
269 (end (event-end start-event
))
271 (if (eq start end
) ;; mouse click
272 (save-selected-window
273 (select-window (posn-window start
))
274 (setq m
(window-margins)
277 col
(car (posn-col-row start
))
279 rm
(max 0 (- w col
)))
280 (message "Right margin set to %d (was %d)" rm rm0
)
281 (set-window-margins nil lm rm
)))))
283 (defun ruler-mode-mouse-set-fill-column (start-event)
284 "Set `fill-column' to the graduation where the mouse pointer is on.
285 START-EVENT is the mouse click event."
287 (let* ((start (event-start start-event
))
288 (end (event-end start-event
))
290 (if (eq start end
) ;; mouse click
291 (save-selected-window
292 (select-window (posn-window start
))
293 (setq m
(window-margins)
296 col
(- (car (posn-col-row start
)) lm
)
300 (and (>= col
0) (< (+ col lm rm
) w
)
302 (message "Fill column set to %d (was %d)" fc fill-column
)
303 (setq fill-column fc
)))))))
305 (defun ruler-mode-mouse-add-tab-stop (start-event)
306 "Add a tab stop to the graduation where the mouse pointer is on.
307 START-EVENT is the mouse click event."
309 (if ruler-mode-show-tab-stops
310 (let* ((start (event-start start-event
))
311 (end (event-end start-event
))
313 (if (eq start end
) ;; mouse click
314 (save-selected-window
315 (select-window (posn-window start
))
316 (setq m
(window-margins)
319 col
(- (car (posn-col-row start
)) lm
)
323 (and (>= col
0) (< (+ col lm rm
) w
)
324 (not (member ts tab-stop-list
))
326 (message "Tab stop set to %d" ts
)
328 (sort (cons ts tab-stop-list
)
331 (defun ruler-mode-mouse-del-tab-stop (start-event)
332 "Delete tab stop at the graduation where the mouse pointer is on.
333 START-EVENT is the mouse click event."
335 (if ruler-mode-show-tab-stops
336 (let* ((start (event-start start-event
))
337 (end (event-end start-event
))
339 (if (eq start end
) ;; mouse click
340 (save-selected-window
341 (select-window (posn-window start
))
342 (setq m
(window-margins)
345 col
(- (car (posn-col-row start
)) lm
)
349 (and (>= col
0) (< (+ col lm rm
) w
)
350 (member ts tab-stop-list
)
352 (message "Tab stop at %d deleted" ts
)
354 (delete ts tab-stop-list
)))))))))
356 (defun ruler-mode-toggle-show-tab-stops ()
357 "Toggle showing of tab stops on the ruler."
359 (setq ruler-mode-show-tab-stops
(not ruler-mode-show-tab-stops
))
360 (force-mode-line-update))
362 (defvar ruler-mode-map
363 (let ((km (make-sparse-keymap)))
364 (define-key km
[header-line down-mouse-1
]
366 (define-key km
[header-line down-mouse-3
]
368 (define-key km
[header-line down-mouse-2
]
369 #'ruler-mode-mouse-set-fill-column
)
370 (define-key km
[header-line
(shift down-mouse-1
)]
371 #'ruler-mode-mouse-set-left-margin
)
372 (define-key km
[header-line
(shift down-mouse-3
)]
373 #'ruler-mode-mouse-set-right-margin
)
374 (define-key km
[header-line
(control down-mouse-1
)]
375 #'ruler-mode-mouse-add-tab-stop
)
376 (define-key km
[header-line
(control down-mouse-3
)]
377 #'ruler-mode-mouse-del-tab-stop
)
378 (define-key km
[header-line
(control down-mouse-2
)]
379 #'ruler-mode-toggle-show-tab-stops
)
381 "Keymap for ruler minor mode.")
383 (defvar ruler-mode-header-line-format-old nil
384 "Hold previous value of `header-line-format'.")
385 (make-variable-buffer-local 'ruler-mode-header-line-format-old
)
387 (defconst ruler-mode-header-line-format
388 '(:eval
(ruler-mode-ruler))
389 "`header-line-format' used in ruler mode.")
392 (define-minor-mode ruler-mode
393 "Display a ruler in the header line if ARG > 0."
399 ;; When `ruler-mode' is on save previous header line format
400 ;; and install the ruler header line format.
401 (setq ruler-mode-header-line-format-old header-line-format
402 header-line-format ruler-mode-header-line-format
)
403 (add-hook 'post-command-hook
; add local hook
404 #'force-mode-line-update nil t
))
405 ;; When `ruler-mode' is off restore previous header line format if
406 ;; the current one is the ruler header line format.
407 (if (eq header-line-format ruler-mode-header-line-format
)
408 (setq header-line-format ruler-mode-header-line-format-old
))
409 (remove-hook 'post-command-hook
; remove local hook
410 #'force-mode-line-update t
)))
412 ;; Add ruler-mode to the minor mode menu in the mode line
413 (define-key mode-line-mode-menu
[ruler-mode
]
414 `(menu-item "Ruler" ruler-mode
415 :button
(:toggle . ruler-mode
)))
417 (defconst ruler-mode-ruler-help-echo
419 S-mouse-1/3: set L/R margin, \
420 mouse-2: set fill col, \
421 C-mouse-2: show tabs"
422 "Help string shown when mouse pointer is over the ruler.
423 `ruler-mode-show-tab-stops' is nil.")
425 (defconst ruler-mode-ruler-help-echo-tab
427 C-mouse1/3: set/unset tab, \
428 C-mouse-2: hide tabs"
429 "Help string shown when mouse pointer is over the ruler.
430 `ruler-mode-show-tab-stops' is non-nil.")
432 (defconst ruler-mode-left-margin-help-echo
434 "Help string shown when mouse is over the left margin area.")
436 (defconst ruler-mode-right-margin-help-echo
438 "Help string shown when mouse is over the right margin area.")
440 (defmacro ruler-mode-left-fringe-cols
()
441 "Return the width, measured in columns, of the left fringe area."
442 '(round (or (frame-parameter nil
'left-fringe
) 0)
445 (defmacro ruler-mode-right-fringe-cols
()
446 "Return the width, measured in columns, of the right fringe area."
447 '(round (or (frame-parameter nil
'right-fringe
) 0)
450 (defmacro ruler-mode-left-scroll-bar-cols
()
451 "Return the width, measured in columns, of the left vertical scrollbar."
452 '(if (eq (frame-parameter nil
'vertical-scroll-bars
) 'left
)
453 (round (or (frame-parameter nil
'scroll-bar-width
) 0)
457 (defmacro ruler-mode-right-scroll-bar-cols
()
458 "Return the width, measured in columns, of the right vertical scrollbar."
459 '(if (eq (frame-parameter nil
'vertical-scroll-bars
) 'right
)
460 (round (or (frame-parameter nil
'scroll-bar-width
) 0)
464 (defun ruler-mode-ruler ()
465 "Return a string ruler."
467 (let* ((j (+ (ruler-mode-left-fringe-cols)
468 (ruler-mode-left-scroll-bar-cols)))
469 (w (+ (window-width) j
))
473 (o (- (window-hscroll) l j
))
477 (make-string w ruler-mode-basic-graduation-char
)
478 ;; extra space to fill the header line
479 (make-string (+ (ruler-mode-right-fringe-cols)
480 (ruler-mode-right-scroll-bar-cols))
484 ;; Setup default face and help echo.
485 (put-text-property 0 (length ruler
)
486 'face
'ruler-mode-default-face
488 (put-text-property 0 (length ruler
)
490 (if ruler-mode-show-tab-stops
491 ruler-mode-ruler-help-echo-tab
492 ruler-mode-ruler-help-echo
)
494 ;; Setup the local map.
495 (put-text-property 0 (length ruler
)
496 'local-map ruler-mode-map
500 ;; Setup the left margin area.
502 i j
'face
'ruler-mode-margins-face
505 i j
'help-echo
(format ruler-mode-left-margin-help-echo l
)
508 (aset ruler i ruler-mode-margins-char
)
511 ;; Setup the ruler area.
517 (setq c
(number-to-string (/ j
10))
521 i
(1+ i
) 'face
'ruler-mode-column-number-face
523 (while (and (> m
0) (>= k
0))
524 (aset ruler k
(aref c
(setq m
(1- m
))))
528 (aset ruler i ruler-mode-inter-graduation-char
)
533 ;; Setup the right margin area.
535 i
(length ruler
) 'face
'ruler-mode-margins-face
538 i
(length ruler
) 'help-echo
539 (format ruler-mode-right-margin-help-echo
(- w r
))
541 (while (< i
(length ruler
))
542 (aset ruler i ruler-mode-margins-char
)
545 ;; Show the `fill-column' marker.
546 (setq i
(- fill-column o
))
547 (and (>= i
0) (< i r
)
548 (aset ruler i ruler-mode-fill-column-char
)
550 i
(1+ i
) 'face
'ruler-mode-fill-column-face
553 ;; Show the `tab-stop-list' markers.
554 (if ruler-mode-show-tab-stops
555 (let ((tsl tab-stop-list
) ts
)
560 (and (>= i
0) (< i r
)
561 (aset ruler i ruler-mode-tab-stop-char
)
565 ;; Don't override the fill-column face
567 'ruler-mode-fill-column-face
)
569 'ruler-mode-tab-stop-face
))
572 ;; Show the `current-column' marker.
573 (setq i
(- (current-column) o
))
574 (and (>= i
0) (< i r
)
575 (aset ruler i ruler-mode-current-column-char
)
577 i
(1+ i
) 'face
'ruler-mode-current-column-face
582 (provide 'ruler-mode
)
585 ;; coding: iso-latin-1
588 ;;; ruler-mode.el ends here