1 ;;; ruler-mode.el --- display a ruler in the header line
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 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: 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., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, 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' `comment-column',
34 ;; `goal-column', `window-margins' and `tab-stop-list' settings:
36 ;; [header-line (shift down-mouse-1)] set left margin end to the ruler
37 ;; graduation where the mouse pointer is on.
39 ;; [header-line (shift down-mouse-3)] set right margin beginning to
40 ;; the ruler graduation where the mouse pointer is on.
42 ;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
43 ;; or `goal-column' to a ruler graduation.
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, `ruler-mode-comment-column-char' shows
59 ;; the `comment-column' location, `ruler-mode-goal-column-char' shows
60 ;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
61 ;; locations. Graduations in `window-margins' and `window-fringes'
62 ;; areas are shown with a different foreground color.
64 ;; It is also possible to customize the following characters:
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' the ruler default face.
74 ;; - `ruler-mode-fill-column' the face used to highlight the
75 ;; `fill-column' character.
76 ;; - `ruler-mode-comment-column' the face used to highlight the
77 ;; `comment-column' character.
78 ;; - `ruler-mode-goal-column' the face used to highlight the
79 ;; `goal-column' character.
80 ;; - `ruler-mode-current-column' the face used to highlight the
81 ;; `current-column' character.
82 ;; - `ruler-mode-tab-stop' the face used to highlight tab stop
84 ;; - `ruler-mode-margins' the face used to highlight graduations
85 ;; in the `window-margins' areas.
86 ;; - `ruler-mode-fringes' the face used to highlight graduations
87 ;; in the `window-fringes' areas.
88 ;; - `ruler-mode-column-number' the face used to highlight the
89 ;; numbered graduations.
91 ;; `ruler-mode-default' inherits from the built-in `default' face.
92 ;; All `ruler-mode' faces inherit from `ruler-mode-default'.
94 ;; WARNING: To keep ruler graduations aligned on text columns it is
95 ;; important to use the same font family and size for ruler and text
98 ;; You can override the ruler format by defining an appropriate
99 ;; function as the buffer-local value of `ruler-mode-ruler-function'.
103 ;; To automatically display the ruler in specific major modes use:
105 ;; (add-hook '<major-mode>-hook 'ruler-mode)
114 (require 'scroll-bar
)
117 (defgroup ruler-mode nil
118 "Display a ruler in the header line."
122 (defcustom ruler-mode-show-tab-stops nil
123 "*If non-nil the ruler shows tab stop positions.
124 Also allowing to visually change `tab-stop-list' setting using
125 <C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
126 or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
127 <C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
131 ;; IMPORTANT: This function must be defined before the following
132 ;; defcustoms because it is used in their :validate clause.
133 (defun ruler-mode-character-validate (widget)
134 "Ensure WIDGET value is a valid character value."
136 (let ((value (widget-value widget
)))
137 (unless (characterp value
)
138 (widget-put widget
:error
139 (format "Invalid character value: %S" value
))
142 (defcustom ruler-mode-fill-column-char
(if (char-displayable-p ?¶
)
145 "*Character used at the `fill-column' location."
148 (character :tag
"Character")
149 (integer :tag
"Integer char value"
150 :validate ruler-mode-character-validate
)))
152 (defcustom ruler-mode-comment-column-char ?\
#
153 "*Character used at the `comment-column' location."
156 (character :tag
"Character")
157 (integer :tag
"Integer char value"
158 :validate ruler-mode-character-validate
)))
160 (defcustom ruler-mode-goal-column-char ?G
161 "*Character used at the `goal-column' location."
164 (character :tag
"Character")
165 (integer :tag
"Integer char value"
166 :validate ruler-mode-character-validate
)))
168 (defcustom ruler-mode-current-column-char
(if (char-displayable-p ?¦
)
171 "*Character used at the `current-column' location."
174 (character :tag
"Character")
175 (integer :tag
"Integer char value"
176 :validate ruler-mode-character-validate
)))
178 (defcustom ruler-mode-tab-stop-char ?\T
179 "*Character used at `tab-stop-list' locations."
182 (character :tag
"Character")
183 (integer :tag
"Integer char value"
184 :validate ruler-mode-character-validate
)))
186 (defcustom ruler-mode-basic-graduation-char ?\.
187 "*Character used for basic graduations."
190 (character :tag
"Character")
191 (integer :tag
"Integer char value"
192 :validate ruler-mode-character-validate
)))
194 (defcustom ruler-mode-inter-graduation-char ?\
!
195 "*Character used for intermediate graduations."
198 (character :tag
"Character")
199 (integer :tag
"Integer char value"
200 :validate ruler-mode-character-validate
)))
202 (defcustom ruler-mode-set-goal-column-ding-flag t
203 "*Non-nil means do `ding' when `goal-column' is set."
207 (defface ruler-mode-default
217 :box
(:color
"grey76"
219 :style released-button
)
221 "Default face used by the ruler."
224 (defface ruler-mode-pad
226 (:inherit ruler-mode-default
230 (:inherit ruler-mode-default
233 "Face used to pad inactive ruler areas."
236 (defface ruler-mode-margins
238 (:inherit ruler-mode-default
241 "Face used to highlight margin areas."
244 (defface ruler-mode-fringes
246 (:inherit ruler-mode-default
249 "Face used to highlight fringes areas."
252 (defface ruler-mode-column-number
254 (:inherit ruler-mode-default
257 "Face used to highlight number graduations."
260 (defface ruler-mode-fill-column
262 (:inherit ruler-mode-default
265 "Face used to highlight the fill column character."
268 (defface ruler-mode-comment-column
270 (:inherit ruler-mode-default
273 "Face used to highlight the comment column character."
276 (defface ruler-mode-goal-column
278 (:inherit ruler-mode-default
281 "Face used to highlight the goal column character."
284 (defface ruler-mode-tab-stop
286 (:inherit ruler-mode-default
287 :foreground
"steelblue"
289 "Face used to highlight tab stop characters."
292 (defface ruler-mode-current-column
294 (:inherit ruler-mode-default
298 "Face used to highlight the `current-column' character."
302 (defsubst ruler-mode-full-window-width
()
303 "Return the full width of the selected window."
304 (let ((edges (window-edges)))
305 (- (nth 2 edges
) (nth 0 edges
))))
307 (defsubst ruler-mode-window-col
(n)
308 "Return a column number relative to the selected window.
309 N is a column number relative to selected frame."
312 (or (car (window-margins)) 0)
313 (fringe-columns 'left
)
314 (scroll-bar-columns 'left
)))
316 (defun ruler-mode-mouse-set-left-margin (start-event)
317 "Set left margin end to the graduation where the mouse pointer is on.
318 START-EVENT is the mouse click event."
320 (let* ((start (event-start start-event
))
321 (end (event-end start-event
))
323 (when (eq start end
) ;; mouse click
324 (save-selected-window
325 (select-window (posn-window start
))
326 (setq col
(- (car (posn-col-row start
)) (car (window-edges))
327 (scroll-bar-columns 'left
))
328 w
(- (ruler-mode-full-window-width)
329 (scroll-bar-columns 'left
)
330 (scroll-bar-columns 'right
)))
331 (when (and (>= col
0) (< col w
))
332 (setq lm
(window-margins)
335 (message "Left margin set to %d (was %d)" col lm
)
336 (set-window-margins nil col rm
))))))
338 (defun ruler-mode-mouse-set-right-margin (start-event)
339 "Set right margin beginning to the graduation where the mouse pointer is on.
340 START-EVENT is the mouse click event."
342 (let* ((start (event-start start-event
))
343 (end (event-end start-event
))
345 (when (eq start end
) ;; mouse click
346 (save-selected-window
347 (select-window (posn-window start
))
348 (setq col
(- (car (posn-col-row start
)) (car (window-edges))
349 (scroll-bar-columns 'left
))
350 w
(- (ruler-mode-full-window-width)
351 (scroll-bar-columns 'left
)
352 (scroll-bar-columns 'right
)))
353 (when (and (>= col
0) (< col w
))
354 (setq lm
(window-margins)
358 (message "Right margin set to %d (was %d)" col rm
)
359 (set-window-margins nil lm col
))))))
361 (defvar ruler-mode-dragged-symbol nil
362 "Column symbol dragged in the ruler.
363 That is `fill-column', `comment-column', `goal-column', or nil when
364 nothing is dragged.")
366 (defun ruler-mode-mouse-grab-any-column (start-event)
367 "Drag a column symbol on the ruler.
368 Start dragging on mouse down event START-EVENT, and update the column
369 symbol value with the current value of the ruler graduation while
370 dragging. See also the variable `ruler-mode-dragged-symbol'."
372 (setq ruler-mode-dragged-symbol nil
)
373 (let* ((start (event-start start-event
))
375 (save-selected-window
376 (select-window (posn-window start
))
377 (setq col
(ruler-mode-window-col (car (posn-col-row start
)))
378 newc
(+ col
(window-hscroll)))
380 (>= col
0) (< col
(window-width))
383 ;; Handle the fill column.
384 ((eq newc fill-column
)
385 (setq oldc fill-column
386 ruler-mode-dragged-symbol
'fill-column
)
389 ;; Handle the comment column.
390 ((eq newc comment-column
)
391 (setq oldc comment-column
392 ruler-mode-dragged-symbol
'comment-column
)
395 ;; Handle the goal column.
396 ;; A. On mouse down on the goal column character on the ruler,
397 ;; update the `goal-column' value while dragging.
398 ;; B. If `goal-column' is nil, set the goal column where the
400 ;; C. On mouse click on the goal column character on the
401 ;; ruler, unset the goal column.
402 ((eq newc goal-column
) ; A. Drag the goal column.
403 (setq oldc goal-column
404 ruler-mode-dragged-symbol
'goal-column
)
407 ((null goal-column
) ; B. Set the goal column.
408 (setq oldc goal-column
410 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
411 ;; `ding' flushes the next messages about setting goal
412 ;; column. So here I force fetch the event(mouse-2) and
415 ;; Ding BEFORE `message' is OK.
416 (when ruler-mode-set-goal-column-ding-flag
418 (message "Goal column set to %d (click on %s again to unset it)"
420 (propertize (char-to-string ruler-mode-goal-column-char
)
421 'face
'ruler-mode-goal-column
))
422 nil
) ;; Don't start dragging.
424 (if (eq 'click
(ruler-mode-mouse-drag-any-column-iteration
425 (posn-window start
)))
426 (when (eq 'goal-column ruler-mode-dragged-symbol
)
427 ;; C. Unset the goal column.
429 ;; At end of dragging, report the updated column symbol.
430 (message "%s is set to %d (was %d)"
431 ruler-mode-dragged-symbol
432 (symbol-value ruler-mode-dragged-symbol
)
435 (defun ruler-mode-mouse-drag-any-column-iteration (window)
436 "Update the ruler while dragging the mouse.
437 WINDOW is the window where occurred the last down-mouse event.
438 Return the symbol `drag' if the mouse has been dragged, or `click' if
439 the mouse has been clicked."
443 (while (mouse-movement-p (setq event
(read-event)))
444 (setq drags
(1+ drags
))
445 (when (eq window
(posn-window (event-end event
)))
446 (ruler-mode-mouse-drag-any-column event
)
447 (force-mode-line-update))))
448 (if (and (zerop drags
) (eq 'click
(car (event-modifiers event
))))
452 (defun ruler-mode-mouse-drag-any-column (start-event)
453 "Update the value of the symbol dragged on the ruler.
454 Called on each mouse motion event START-EVENT."
455 (let* ((start (event-start start-event
))
456 (end (event-end start-event
))
458 (save-selected-window
459 (select-window (posn-window start
))
460 (setq col
(ruler-mode-window-col (car (posn-col-row end
)))
461 newc
(+ col
(window-hscroll)))
462 (when (and (>= col
0) (< col
(window-width)))
463 (set ruler-mode-dragged-symbol newc
)))))
465 (defun ruler-mode-mouse-add-tab-stop (start-event)
466 "Add a tab stop to the graduation where the mouse pointer is on.
467 START-EVENT is the mouse click event."
469 (when ruler-mode-show-tab-stops
470 (let* ((start (event-start start-event
))
471 (end (event-end start-event
))
473 (when (eq start end
) ;; mouse click
474 (save-selected-window
475 (select-window (posn-window start
))
476 (setq col
(ruler-mode-window-col (car (posn-col-row start
)))
477 ts
(+ col
(window-hscroll)))
478 (and (>= col
0) (< col
(window-width))
479 (not (member ts tab-stop-list
))
481 (message "Tab stop set to %d" ts
)
482 (setq tab-stop-list
(sort (cons ts tab-stop-list
)
485 (defun ruler-mode-mouse-del-tab-stop (start-event)
486 "Delete tab stop at the graduation where the mouse pointer is on.
487 START-EVENT is the mouse click event."
489 (when ruler-mode-show-tab-stops
490 (let* ((start (event-start start-event
))
491 (end (event-end start-event
))
493 (when (eq start end
) ;; mouse click
494 (save-selected-window
495 (select-window (posn-window start
))
496 (setq col
(ruler-mode-window-col (car (posn-col-row start
)))
497 ts
(+ col
(window-hscroll)))
498 (and (>= col
0) (< col
(window-width))
499 (member ts tab-stop-list
)
501 (message "Tab stop at %d deleted" ts
)
502 (setq tab-stop-list
(delete ts tab-stop-list
)))))))))
504 (defun ruler-mode-toggle-show-tab-stops ()
505 "Toggle showing of tab stops on the ruler."
507 (setq ruler-mode-show-tab-stops
(not ruler-mode-show-tab-stops
))
508 (force-mode-line-update))
510 (defvar ruler-mode-map
511 (let ((km (make-sparse-keymap)))
512 (define-key km
[header-line down-mouse-1
]
514 (define-key km
[header-line down-mouse-3
]
516 (define-key km
[header-line down-mouse-2
]
517 #'ruler-mode-mouse-grab-any-column
)
518 (define-key km
[header-line
(shift down-mouse-1
)]
519 #'ruler-mode-mouse-set-left-margin
)
520 (define-key km
[header-line
(shift down-mouse-3
)]
521 #'ruler-mode-mouse-set-right-margin
)
522 (define-key km
[header-line
(control down-mouse-1
)]
523 #'ruler-mode-mouse-add-tab-stop
)
524 (define-key km
[header-line
(control down-mouse-3
)]
525 #'ruler-mode-mouse-del-tab-stop
)
526 (define-key km
[header-line
(control down-mouse-2
)]
527 #'ruler-mode-toggle-show-tab-stops
)
529 "Keymap for ruler minor mode.")
531 (defvar ruler-mode-header-line-format-old nil
532 "Hold previous value of `header-line-format'.")
534 (defvar ruler-mode-ruler-function
'ruler-mode-ruler
535 "Function to call to return ruler header line format.
536 This variable is expected to be made buffer-local by modes.")
538 (defconst ruler-mode-header-line-format
539 '(:eval
(funcall ruler-mode-ruler-function
))
540 "`header-line-format' used in ruler mode.
541 Call `ruler-mode-ruler-function' to compute the ruler value.")
544 (define-minor-mode ruler-mode
545 "Display a ruler in the header line if ARG > 0."
551 ;; When `ruler-mode' is on save previous header line format
552 ;; and install the ruler header line format.
553 (when (local-variable-p 'header-line-format
)
554 (set (make-local-variable 'ruler-mode-header-line-format-old
)
556 (setq header-line-format ruler-mode-header-line-format
)
557 (add-hook 'post-command-hook
'force-mode-line-update nil t
))
558 ;; When `ruler-mode' is off restore previous header line format if
559 ;; the current one is the ruler header line format.
560 (when (eq header-line-format ruler-mode-header-line-format
)
561 (kill-local-variable 'header-line-format
)
562 (when (local-variable-p 'ruler-mode-header-line-format-old
)
563 (setq header-line-format ruler-mode-header-line-format-old
)
564 (kill-local-variable 'ruler-mode-header-line-format-old
)))
565 (remove-hook 'post-command-hook
'force-mode-line-update t
)))
567 ;; Add ruler-mode to the minor mode menu in the mode line
568 (define-key mode-line-mode-menu
[ruler-mode
]
569 `(menu-item "Ruler" ruler-mode
570 :button
(:toggle . ruler-mode
)))
572 (defconst ruler-mode-ruler-help-echo
574 S-mouse-1/3: set L/R margin, \
575 mouse-2: set goal column, \
576 C-mouse-2: show tabs"
577 "Help string shown when mouse is over the ruler.
578 `ruler-mode-show-tab-stops' is nil.")
580 (defconst ruler-mode-ruler-help-echo-when-goal-column
582 S-mouse-1/3: set L/R margin, \
583 C-mouse-2: show tabs"
584 "Help string shown when mouse is over the ruler.
585 `goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
587 (defconst ruler-mode-ruler-help-echo-when-tab-stops
589 C-mouse1/3: set/unset tab, \
590 C-mouse-2: hide tabs"
591 "Help string shown when mouse is over the ruler.
592 `ruler-mode-show-tab-stops' is non-nil.")
594 (defconst ruler-mode-fill-column-help-echo
595 "drag-mouse-2: set fill column"
596 "Help string shown when mouse is on the fill column character.")
598 (defconst ruler-mode-comment-column-help-echo
599 "drag-mouse-2: set comment column"
600 "Help string shown when mouse is on the comment column character.")
602 (defconst ruler-mode-goal-column-help-echo
604 drag-mouse-2: set goal column, \
605 mouse-2: unset goal column"
606 "Help string shown when mouse is on the goal column character.")
608 (defconst ruler-mode-margin-help-echo
610 "Help string shown when mouse is over a margin area.")
612 (defconst ruler-mode-fringe-help-echo
614 "Help string shown when mouse is over a fringe area.")
616 (defsubst ruler-mode-space
(width &rest props
)
617 "Return a single space string of WIDTH times the normal character width.
618 Optional argument PROPS specifies other text properties to apply."
619 (apply 'propertize
" " 'display
(list 'space
:width width
) props
))
621 (defun ruler-mode-ruler ()
622 "Compute and return an header line ruler."
623 (let* ((w (window-width))
628 ;; Setup the scrollbar, fringes, and margins areas.
629 (lf (ruler-mode-space
631 'face
'ruler-mode-fringes
632 'help-echo
(format ruler-mode-fringe-help-echo
633 "Left" (or (car f
) 0))))
634 (rf (ruler-mode-space
636 'face
'ruler-mode-fringes
637 'help-echo
(format ruler-mode-fringe-help-echo
638 "Right" (or (cadr f
) 0))))
639 (lm (ruler-mode-space
641 'face
'ruler-mode-margins
642 'help-echo
(format ruler-mode-margin-help-echo
643 "Left" (or (car m
) 0))))
644 (rm (ruler-mode-space
646 'face
'ruler-mode-margins
647 'help-echo
(format ruler-mode-margin-help-echo
648 "Right" (or (cdr m
) 0))))
649 (sb (ruler-mode-space
651 'face
'ruler-mode-pad
))
652 ;; Remember the scrollbar vertical type.
653 (sbvt (car (window-current-scroll-bars)))
654 ;; Create an "clean" ruler.
657 (make-string w ruler-mode-basic-graduation-char
)
658 'face
'ruler-mode-default
659 'local-map ruler-mode-map
661 (ruler-mode-show-tab-stops
662 ruler-mode-ruler-help-echo-when-tab-stops
)
664 ruler-mode-ruler-help-echo-when-goal-column
)
665 (ruler-mode-ruler-help-echo))))
667 ;; Setup the active area.
671 ;; Show a number graduation.
673 (setq c
(number-to-string (/ j
10))
677 i
(1+ i
) 'face
'ruler-mode-column-number
679 (while (and (> m
0) (>= k
0))
680 (aset ruler k
(aref c
(setq m
(1- m
))))
682 ;; Show an intermediate graduation.
684 (aset ruler i ruler-mode-inter-graduation-char
)))
687 ;; Show the `current-column' marker.
688 ((= j
(current-column))
689 (aset ruler i ruler-mode-current-column-char
)
691 i
(1+ i
) 'face
'ruler-mode-current-column
693 ;; Show the `goal-column' marker.
694 ((and goal-column
(= j goal-column
))
695 (aset ruler i ruler-mode-goal-column-char
)
697 i
(1+ i
) 'face
'ruler-mode-goal-column
700 i
(1+ i
) 'mouse-face
'mode-line-highlight
703 i
(1+ i
) 'help-echo ruler-mode-goal-column-help-echo
705 ;; Show the `comment-column' marker.
706 ((= j comment-column
)
707 (aset ruler i ruler-mode-comment-column-char
)
709 i
(1+ i
) 'face
'ruler-mode-comment-column
712 i
(1+ i
) 'mouse-face
'mode-line-highlight
715 i
(1+ i
) 'help-echo ruler-mode-comment-column-help-echo
717 ;; Show the `fill-column' marker.
719 (aset ruler i ruler-mode-fill-column-char
)
721 i
(1+ i
) 'face
'ruler-mode-fill-column
724 i
(1+ i
) 'mouse-face
'mode-line-highlight
727 i
(1+ i
) 'help-echo ruler-mode-fill-column-help-echo
729 ;; Show the `tab-stop-list' markers.
730 ((and ruler-mode-show-tab-stops
(member j tab-stop-list
))
731 (aset ruler i ruler-mode-tab-stop-char
)
733 i
(1+ i
) 'face
'ruler-mode-tab-stop
737 ;; Return the ruler propertized string. Using list here,
738 ;; instead of concat visually separate the different areas.
739 (if (nth 2 (window-fringes))
740 ;; fringes outside margins.
741 (list "" (and (eq 'left sbvt
) sb
) lf lm
742 ruler rm rf
(and (eq 'right sbvt
) sb
))
743 ;; fringes inside margins.
744 (list "" (and (eq 'left sbvt
) sb
) lm lf
745 ruler rf rm
(and (eq 'right sbvt
) sb
)))))
747 (provide 'ruler-mode
)
750 ;; coding: iso-latin-1
753 ;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
754 ;;; ruler-mode.el ends here