1 ;;; ruler-mode.el --- display a ruler in the header line
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008, 2009 Free Software Foundation, Inc.
6 ;; Author: David Ponce <david@dponce.com>
7 ;; Maintainer: David Ponce <david@dponce.com>
8 ;; Created: 24 Mar 2001
10 ;; Keywords: convenience
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; This library provides a minor mode to display a ruler in the header
30 ;; line. It works from Emacs 21 onwards.
32 ;; You can use the mouse to change the `fill-column' `comment-column',
33 ;; `goal-column', `window-margins' and `tab-stop-list' settings:
35 ;; [header-line (shift down-mouse-1)] set left margin end to the ruler
36 ;; graduation where the mouse pointer is on.
38 ;; [header-line (shift down-mouse-3)] set right margin beginning to
39 ;; the ruler graduation where the mouse pointer is on.
41 ;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
42 ;; or `goal-column' to a ruler graduation.
44 ;; [header-line (control down-mouse-1)] add a tab stop to the ruler
45 ;; graduation where the mouse pointer is on.
47 ;; [header-line (control down-mouse-3)] remove the tab stop at the
48 ;; ruler graduation where the mouse pointer is on.
50 ;; [header-line (control down-mouse-2)] or M-x
51 ;; `ruler-mode-toggle-show-tab-stops' toggle showing and visually
52 ;; editing `tab-stop-list' setting. The `ruler-mode-show-tab-stops'
53 ;; option controls if the ruler shows tab stops by default.
55 ;; In the ruler the character `ruler-mode-current-column-char' shows
56 ;; the `current-column' location, `ruler-mode-fill-column-char' shows
57 ;; the `fill-column' location, `ruler-mode-comment-column-char' shows
58 ;; the `comment-column' location, `ruler-mode-goal-column-char' shows
59 ;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
60 ;; locations. Graduations in `window-margins' and `window-fringes'
61 ;; areas are shown with a different foreground color.
63 ;; It is also possible to customize the following characters:
65 ;; - `ruler-mode-basic-graduation-char' character used for basic
66 ;; graduations ('.' by default).
67 ;; - `ruler-mode-inter-graduation-char' character used for
68 ;; intermediate graduations ('!' by default).
70 ;; The following faces are customizable:
72 ;; - `ruler-mode-default' the ruler default face.
73 ;; - `ruler-mode-fill-column' the face used to highlight the
74 ;; `fill-column' character.
75 ;; - `ruler-mode-comment-column' the face used to highlight the
76 ;; `comment-column' character.
77 ;; - `ruler-mode-goal-column' the face used to highlight the
78 ;; `goal-column' character.
79 ;; - `ruler-mode-current-column' the face used to highlight the
80 ;; `current-column' character.
81 ;; - `ruler-mode-tab-stop' the face used to highlight tab stop
83 ;; - `ruler-mode-margins' the face used to highlight graduations
84 ;; in the `window-margins' areas.
85 ;; - `ruler-mode-fringes' the face used to highlight graduations
86 ;; in the `window-fringes' areas.
87 ;; - `ruler-mode-column-number' the face used to highlight the
88 ;; numbered graduations.
90 ;; `ruler-mode-default' inherits from the built-in `default' face.
91 ;; All `ruler-mode' faces inherit from `ruler-mode-default'.
93 ;; WARNING: To keep ruler graduations aligned on text columns it is
94 ;; important to use the same font family and size for ruler and text
97 ;; You can override the ruler format by defining an appropriate
98 ;; function as the buffer-local value of `ruler-mode-ruler-function'.
102 ;; To automatically display the ruler in specific major modes use:
104 ;; (add-hook '<major-mode>-hook 'ruler-mode)
113 (require 'scroll-bar)
116 (defgroup ruler-mode nil
117 "Display a ruler in the header line."
121 (defcustom ruler-mode-show-tab-stops nil
122 "If non-nil the ruler shows tab stop positions.
123 Also allowing to visually change `tab-stop-list' setting using
124 <C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
125 or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
126 <C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
130 ;; IMPORTANT: This function must be defined before the following
131 ;; defcustoms because it is used in their :validate clause.
132 (defun ruler-mode-character-validate (widget)
133 "Ensure WIDGET value is a valid character value."
135 (let ((value (widget-value widget)))
136 (unless (characterp value)
137 (widget-put widget :error
138 (format "Invalid character value: %S" value))
141 (defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶)
144 "Character used at the `fill-column' location."
147 (character :tag "Character")
148 (integer :tag "Integer char value"
149 :validate ruler-mode-character-validate)))
151 (defcustom ruler-mode-comment-column-char ?\#
152 "Character used at the `comment-column' location."
155 (character :tag "Character")
156 (integer :tag "Integer char value"
157 :validate ruler-mode-character-validate)))
159 (defcustom ruler-mode-goal-column-char ?G
160 "Character used at the `goal-column' location."
163 (character :tag "Character")
164 (integer :tag "Integer char value"
165 :validate ruler-mode-character-validate)))
167 (defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦)
170 "Character used at the `current-column' location."
173 (character :tag "Character")
174 (integer :tag "Integer char value"
175 :validate ruler-mode-character-validate)))
177 (defcustom ruler-mode-tab-stop-char ?\T
178 "Character used at `tab-stop-list' locations."
181 (character :tag "Character")
182 (integer :tag "Integer char value"
183 :validate ruler-mode-character-validate)))
185 (defcustom ruler-mode-basic-graduation-char ?\.
186 "Character used for basic graduations."
189 (character :tag "Character")
190 (integer :tag "Integer char value"
191 :validate ruler-mode-character-validate)))
193 (defcustom ruler-mode-inter-graduation-char ?\!
194 "Character used for intermediate graduations."
197 (character :tag "Character")
198 (integer :tag "Integer char value"
199 :validate ruler-mode-character-validate)))
201 (defcustom ruler-mode-set-goal-column-ding-flag t
202 "Non-nil means do `ding' when `goal-column' is set."
206 (defface ruler-mode-default
216 :box (:color "grey76"
218 :style released-button)
220 "Default face used by the ruler."
223 (defface ruler-mode-pad
225 (:inherit ruler-mode-default
229 (:inherit ruler-mode-default
232 "Face used to pad inactive ruler areas."
235 (defface ruler-mode-margins
237 (:inherit ruler-mode-default
240 "Face used to highlight margin areas."
243 (defface ruler-mode-fringes
245 (:inherit ruler-mode-default
248 "Face used to highlight fringes areas."
251 (defface ruler-mode-column-number
253 (:inherit ruler-mode-default
256 "Face used to highlight number graduations."
259 (defface ruler-mode-fill-column
261 (:inherit ruler-mode-default
264 "Face used to highlight the fill column character."
267 (defface ruler-mode-comment-column
269 (:inherit ruler-mode-default
272 "Face used to highlight the comment column character."
275 (defface ruler-mode-goal-column
277 (:inherit ruler-mode-default
280 "Face used to highlight the goal column character."
283 (defface ruler-mode-tab-stop
285 (:inherit ruler-mode-default
286 :foreground "steelblue"
288 "Face used to highlight tab stop characters."
291 (defface ruler-mode-current-column
293 (:inherit ruler-mode-default
297 "Face used to highlight the `current-column' character."
301 (defsubst ruler-mode-full-window-width ()
302 "Return the full width of the selected window."
303 (let ((edges (window-edges)))
304 (- (nth 2 edges) (nth 0 edges))))
306 (defsubst ruler-mode-window-col (n)
307 "Return a column number relative to the selected window.
308 N is a column number relative to selected frame."
311 (or (car (window-margins)) 0)
312 (fringe-columns 'left)
313 (scroll-bar-columns 'left)))
315 (defun ruler-mode-mouse-set-left-margin (start-event)
316 "Set left margin end to the graduation where the mouse pointer is on.
317 START-EVENT is the mouse click event."
319 (let* ((start (event-start start-event))
320 (end (event-end start-event))
322 (when (eq start end) ;; mouse click
323 (save-selected-window
324 (select-window (posn-window start))
325 (setq col (- (car (posn-col-row start)) (car (window-edges))
326 (scroll-bar-columns 'left))
327 w (- (ruler-mode-full-window-width)
328 (scroll-bar-columns 'left)
329 (scroll-bar-columns 'right)))
330 (when (and (>= col 0) (< col w))
331 (setq lm (window-margins)
334 (message "Left margin set to %d (was %d)" col lm)
335 (set-window-margins nil col rm))))))
337 (defun ruler-mode-mouse-set-right-margin (start-event)
338 "Set right margin beginning to the graduation where the mouse pointer is on.
339 START-EVENT is the mouse click event."
341 (let* ((start (event-start start-event))
342 (end (event-end start-event))
344 (when (eq start end) ;; mouse click
345 (save-selected-window
346 (select-window (posn-window start))
347 (setq col (- (car (posn-col-row start)) (car (window-edges))
348 (scroll-bar-columns 'left))
349 w (- (ruler-mode-full-window-width)
350 (scroll-bar-columns 'left)
351 (scroll-bar-columns 'right)))
352 (when (and (>= col 0) (< col w))
353 (setq lm (window-margins)
357 (message "Right margin set to %d (was %d)" col rm)
358 (set-window-margins nil lm col))))))
360 (defvar ruler-mode-dragged-symbol nil
361 "Column symbol dragged in the ruler.
362 That is `fill-column', `comment-column', `goal-column', or nil when
363 nothing is dragged.")
365 (defun ruler-mode-mouse-grab-any-column (start-event)
366 "Drag a column symbol on the ruler.
367 Start dragging on mouse down event START-EVENT, and update the column
368 symbol value with the current value of the ruler graduation while
369 dragging. See also the variable `ruler-mode-dragged-symbol'."
371 (setq ruler-mode-dragged-symbol nil)
372 (let* ((start (event-start start-event))
374 (save-selected-window
375 (select-window (posn-window start))
376 (setq col (ruler-mode-window-col (car (posn-col-row start)))
377 newc (+ col (window-hscroll)))
379 (>= col 0) (< col (window-width))
382 ;; Handle the fill column.
383 ((eq newc fill-column)
384 (setq oldc fill-column
385 ruler-mode-dragged-symbol 'fill-column)
388 ;; Handle the comment column.
389 ((eq newc comment-column)
390 (setq oldc comment-column
391 ruler-mode-dragged-symbol 'comment-column)
394 ;; Handle the goal column.
395 ;; A. On mouse down on the goal column character on the ruler,
396 ;; update the `goal-column' value while dragging.
397 ;; B. If `goal-column' is nil, set the goal column where the
399 ;; C. On mouse click on the goal column character on the
400 ;; ruler, unset the goal column.
401 ((eq newc goal-column) ; A. Drag the goal column.
402 (setq oldc goal-column
403 ruler-mode-dragged-symbol 'goal-column)
406 ((null goal-column) ; B. Set the goal column.
407 (setq oldc goal-column
409 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
410 ;; `ding' flushes the next messages about setting goal
411 ;; column. So here I force fetch the event(mouse-2) and
414 ;; Ding BEFORE `message' is OK.
415 (when ruler-mode-set-goal-column-ding-flag
417 (message "Goal column set to %d (click on %s again to unset it)"
419 (propertize (char-to-string ruler-mode-goal-column-char)
420 'face 'ruler-mode-goal-column))
421 nil) ;; Don't start dragging.
423 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
424 (posn-window start)))
425 (when (eq 'goal-column ruler-mode-dragged-symbol)
426 ;; C. Unset the goal column.
428 ;; At end of dragging, report the updated column symbol.
429 (message "%s is set to %d (was %d)"
430 ruler-mode-dragged-symbol
431 (symbol-value ruler-mode-dragged-symbol)
434 (defun ruler-mode-mouse-drag-any-column-iteration (window)
435 "Update the ruler while dragging the mouse.
436 WINDOW is the window where occurred the last down-mouse event.
437 Return the symbol `drag' if the mouse has been dragged, or `click' if
438 the mouse has been clicked."
442 (while (mouse-movement-p (setq event (read-event)))
443 (setq drags (1+ drags))
444 (when (eq window (posn-window (event-end event)))
445 (ruler-mode-mouse-drag-any-column event)
446 (force-mode-line-update))))
447 (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
451 (defun ruler-mode-mouse-drag-any-column (start-event)
452 "Update the value of the symbol dragged on the ruler.
453 Called on each mouse motion event START-EVENT."
454 (let* ((start (event-start start-event))
455 (end (event-end start-event))
457 (save-selected-window
458 (select-window (posn-window start))
459 (setq col (ruler-mode-window-col (car (posn-col-row end)))
460 newc (+ col (window-hscroll)))
461 (when (and (>= col 0) (< col (window-width)))
462 (set ruler-mode-dragged-symbol newc)))))
464 (defun ruler-mode-mouse-add-tab-stop (start-event)
465 "Add a tab stop to the graduation where the mouse pointer is on.
466 START-EVENT is the mouse click event."
468 (when ruler-mode-show-tab-stops
469 (let* ((start (event-start start-event))
470 (end (event-end start-event))
472 (when (eq start end) ;; mouse click
473 (save-selected-window
474 (select-window (posn-window start))
475 (setq col (ruler-mode-window-col (car (posn-col-row start)))
476 ts (+ col (window-hscroll)))
477 (and (>= col 0) (< col (window-width))
478 (not (member ts tab-stop-list))
480 (message "Tab stop set to %d" ts)
481 (setq tab-stop-list (sort (cons ts tab-stop-list)
484 (defun ruler-mode-mouse-del-tab-stop (start-event)
485 "Delete tab stop at the graduation where the mouse pointer is on.
486 START-EVENT is the mouse click event."
488 (when ruler-mode-show-tab-stops
489 (let* ((start (event-start start-event))
490 (end (event-end start-event))
492 (when (eq start end) ;; mouse click
493 (save-selected-window
494 (select-window (posn-window start))
495 (setq col (ruler-mode-window-col (car (posn-col-row start)))
496 ts (+ col (window-hscroll)))
497 (and (>= col 0) (< col (window-width))
498 (member ts tab-stop-list)
500 (message "Tab stop at %d deleted" ts)
501 (setq tab-stop-list (delete ts tab-stop-list)))))))))
503 (defun ruler-mode-toggle-show-tab-stops ()
504 "Toggle showing of tab stops on the ruler."
506 (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
507 (force-mode-line-update))
509 (defvar ruler-mode-map
510 (let ((km (make-sparse-keymap)))
511 (define-key km [header-line down-mouse-1]
513 (define-key km [header-line down-mouse-3]
515 (define-key km [header-line down-mouse-2]
516 #'ruler-mode-mouse-grab-any-column)
517 (define-key km [header-line (shift down-mouse-1)]
518 #'ruler-mode-mouse-set-left-margin)
519 (define-key km [header-line (shift down-mouse-3)]
520 #'ruler-mode-mouse-set-right-margin)
521 (define-key km [header-line (control down-mouse-1)]
522 #'ruler-mode-mouse-add-tab-stop)
523 (define-key km [header-line (control down-mouse-3)]
524 #'ruler-mode-mouse-del-tab-stop)
525 (define-key km [header-line (control down-mouse-2)]
526 #'ruler-mode-toggle-show-tab-stops)
527 (define-key km [header-line (shift mouse-1)]
529 (define-key km [header-line (shift mouse-3)]
531 (define-key km [header-line (control mouse-1)]
533 (define-key km [header-line (control mouse-3)]
535 (define-key km [header-line (control mouse-2)]
538 "Keymap for ruler minor mode.")
540 (defvar ruler-mode-header-line-format-old nil
541 "Hold previous value of `header-line-format'.")
543 (defvar ruler-mode-ruler-function 'ruler-mode-ruler
544 "Function to call to return ruler header line format.
545 This variable is expected to be made buffer-local by modes.")
547 (defconst ruler-mode-header-line-format
548 '(:eval (funcall ruler-mode-ruler-function))
549 "`header-line-format' used in ruler mode.
550 Call `ruler-mode-ruler-function' to compute the ruler value.")
553 (define-minor-mode ruler-mode
554 "Display a ruler in the header line if ARG > 0."
560 ;; When `ruler-mode' is on save previous header line format
561 ;; and install the ruler header line format.
562 (when (and (local-variable-p 'header-line-format)
563 (not (local-variable-p 'ruler-mode-header-line-format-old)))
564 (set (make-local-variable 'ruler-mode-header-line-format-old)
566 (setq header-line-format ruler-mode-header-line-format)
567 (add-hook 'post-command-hook 'force-mode-line-update nil t))
568 ;; When `ruler-mode' is off restore previous header line format if
569 ;; the current one is the ruler header line format.
570 (when (eq header-line-format ruler-mode-header-line-format)
571 (kill-local-variable 'header-line-format)
572 (when (local-variable-p 'ruler-mode-header-line-format-old)
573 (setq header-line-format ruler-mode-header-line-format-old)
574 (kill-local-variable 'ruler-mode-header-line-format-old)))
575 (remove-hook 'post-command-hook 'force-mode-line-update t)))
577 ;; Add ruler-mode to the minor mode menu in the mode line
578 (define-key mode-line-mode-menu [ruler-mode]
579 `(menu-item "Ruler" ruler-mode
580 :button (:toggle . ruler-mode)))
582 (defconst ruler-mode-ruler-help-echo
584 S-mouse-1/3: set L/R margin, \
585 mouse-2: set goal column, \
586 C-mouse-2: show tabs"
587 "Help string shown when mouse is over the ruler.
588 `ruler-mode-show-tab-stops' is nil.")
590 (defconst ruler-mode-ruler-help-echo-when-goal-column
592 S-mouse-1/3: set L/R margin, \
593 C-mouse-2: show tabs"
594 "Help string shown when mouse is over the ruler.
595 `goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
597 (defconst ruler-mode-ruler-help-echo-when-tab-stops
599 C-mouse1/3: set/unset tab, \
600 C-mouse-2: hide tabs"
601 "Help string shown when mouse is over the ruler.
602 `ruler-mode-show-tab-stops' is non-nil.")
604 (defconst ruler-mode-fill-column-help-echo
605 "drag-mouse-2: set fill column"
606 "Help string shown when mouse is on the fill column character.")
608 (defconst ruler-mode-comment-column-help-echo
609 "drag-mouse-2: set comment column"
610 "Help string shown when mouse is on the comment column character.")
612 (defconst ruler-mode-goal-column-help-echo
614 drag-mouse-2: set goal column, \
615 mouse-2: unset goal column"
616 "Help string shown when mouse is on the goal column character.")
618 (defconst ruler-mode-margin-help-echo
620 "Help string shown when mouse is over a margin area.")
622 (defconst ruler-mode-fringe-help-echo
624 "Help string shown when mouse is over a fringe area.")
626 (defsubst ruler-mode-space (width &rest props)
627 "Return a single space string of WIDTH times the normal character width.
628 Optional argument PROPS specifies other text properties to apply."
629 (apply 'propertize " " 'display (list 'space :width width) props))
631 (defun ruler-mode-ruler ()
632 "Compute and return a header line ruler."
633 (let* ((w (window-width))
638 ;; Setup the scrollbar, fringes, and margins areas.
639 (lf (ruler-mode-space
641 'face 'ruler-mode-fringes
642 'help-echo (format ruler-mode-fringe-help-echo
643 "Left" (or (car f) 0))))
644 (rf (ruler-mode-space
646 'face 'ruler-mode-fringes
647 'help-echo (format ruler-mode-fringe-help-echo
648 "Right" (or (cadr f) 0))))
649 (lm (ruler-mode-space
651 'face 'ruler-mode-margins
652 'help-echo (format ruler-mode-margin-help-echo
653 "Left" (or (car m) 0))))
654 (rm (ruler-mode-space
656 'face 'ruler-mode-margins
657 'help-echo (format ruler-mode-margin-help-echo
658 "Right" (or (cdr m) 0))))
659 (sb (ruler-mode-space
661 'face 'ruler-mode-pad))
662 ;; Remember the scrollbar vertical type.
663 (sbvt (car (window-current-scroll-bars)))
664 ;; Create an "clean" ruler.
668 (make-string w ruler-mode-basic-graduation-char))
669 'face 'ruler-mode-default
670 'local-map ruler-mode-map
672 (ruler-mode-show-tab-stops
673 ruler-mode-ruler-help-echo-when-tab-stops)
675 ruler-mode-ruler-help-echo-when-goal-column)
676 (ruler-mode-ruler-help-echo))))
678 ;; Setup the active area.
682 ;; Show a number graduation.
684 (setq c (number-to-string (/ j 10))
688 i (1+ i) 'face 'ruler-mode-column-number
690 (while (and (> m 0) (>= k 0))
691 (aset ruler k (aref c (setq m (1- m))))
693 ;; Show an intermediate graduation.
695 (aset ruler i ruler-mode-inter-graduation-char)))
698 ;; Show the `current-column' marker.
699 ((= j (current-column))
700 (aset ruler i ruler-mode-current-column-char)
702 i (1+ i) 'face 'ruler-mode-current-column
704 ;; Show the `goal-column' marker.
705 ((and goal-column (= j goal-column))
706 (aset ruler i ruler-mode-goal-column-char)
708 i (1+ i) 'face 'ruler-mode-goal-column
711 i (1+ i) 'mouse-face 'mode-line-highlight
714 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
716 ;; Show the `comment-column' marker.
717 ((= j comment-column)
718 (aset ruler i ruler-mode-comment-column-char)
720 i (1+ i) 'face 'ruler-mode-comment-column
723 i (1+ i) 'mouse-face 'mode-line-highlight
726 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
728 ;; Show the `fill-column' marker.
730 (aset ruler i ruler-mode-fill-column-char)
732 i (1+ i) 'face 'ruler-mode-fill-column
735 i (1+ i) 'mouse-face 'mode-line-highlight
738 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
740 ;; Show the `tab-stop-list' markers.
741 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
742 (aset ruler i ruler-mode-tab-stop-char)
744 i (1+ i) 'face 'ruler-mode-tab-stop
748 ;; Return the ruler propertized string. Using list here,
749 ;; instead of concat visually separate the different areas.
750 (if (nth 2 (window-fringes))
751 ;; fringes outside margins.
752 (list "" (and (eq 'left sbvt) sb) lf lm
753 ruler rm rf (and (eq 'right sbvt) sb))
754 ;; fringes inside margins.
755 (list "" (and (eq 'left sbvt) sb) lm lf
756 ruler rf rm (and (eq 'right sbvt) sb)))))
758 (provide 'ruler-mode)
761 ;; coding: iso-latin-1
764 ;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
765 ;;; ruler-mode.el ends here