*** empty log message ***
[emacs.git] / lisp / ruler-mode.el
blob6b77a912dcff166504e898ba572efadea1fcebef
1 ;;; ruler-mode.el --- display a ruler in the header line
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: David Ponce <david@dponce.com>
7 ;; Maintainer: David Ponce <david@dponce.com>
8 ;; Created: 24 Mar 2001
9 ;; Version: 1.6
10 ;; Keywords: convenience
12 ;; This file is part of GNU Emacs.
14 ;; This program is free software; you can redistribute it and/or
15 ;; modify it under the terms of the GNU General Public License as
16 ;; published by the Free Software Foundation; either version 3, or (at
17 ;; your option) any later version.
19 ;; This program is distributed in the hope that it will be useful, but
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program; see the file COPYING. If not, write to
26 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
29 ;;; Commentary:
31 ;; This library provides a minor mode to display a ruler in the header
32 ;; line. It works from Emacs 21 onwards.
34 ;; You can use the mouse to change the `fill-column' `comment-column',
35 ;; `goal-column', `window-margins' and `tab-stop-list' settings:
37 ;; [header-line (shift down-mouse-1)] set left margin end to the ruler
38 ;; graduation where the mouse pointer is on.
40 ;; [header-line (shift down-mouse-3)] set right margin beginning to
41 ;; the ruler graduation where the mouse pointer is on.
43 ;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
44 ;; or `goal-column' to a ruler graduation.
46 ;; [header-line (control down-mouse-1)] add a tab stop to the ruler
47 ;; graduation where the mouse pointer is on.
49 ;; [header-line (control down-mouse-3)] remove the tab stop at the
50 ;; ruler graduation where the mouse pointer is on.
52 ;; [header-line (control down-mouse-2)] or M-x
53 ;; `ruler-mode-toggle-show-tab-stops' toggle showing and visually
54 ;; editing `tab-stop-list' setting. The `ruler-mode-show-tab-stops'
55 ;; option controls if the ruler shows tab stops by default.
57 ;; In the ruler the character `ruler-mode-current-column-char' shows
58 ;; the `current-column' location, `ruler-mode-fill-column-char' shows
59 ;; the `fill-column' location, `ruler-mode-comment-column-char' shows
60 ;; the `comment-column' location, `ruler-mode-goal-column-char' shows
61 ;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
62 ;; locations. Graduations in `window-margins' and `window-fringes'
63 ;; areas are shown with a different foreground color.
65 ;; It is also possible to customize the following characters:
67 ;; - `ruler-mode-basic-graduation-char' character used for basic
68 ;; graduations ('.' by default).
69 ;; - `ruler-mode-inter-graduation-char' character used for
70 ;; intermediate graduations ('!' by default).
72 ;; The following faces are customizable:
74 ;; - `ruler-mode-default' the ruler default face.
75 ;; - `ruler-mode-fill-column' the face used to highlight the
76 ;; `fill-column' character.
77 ;; - `ruler-mode-comment-column' the face used to highlight the
78 ;; `comment-column' character.
79 ;; - `ruler-mode-goal-column' the face used to highlight the
80 ;; `goal-column' character.
81 ;; - `ruler-mode-current-column' the face used to highlight the
82 ;; `current-column' character.
83 ;; - `ruler-mode-tab-stop' the face used to highlight tab stop
84 ;; characters.
85 ;; - `ruler-mode-margins' the face used to highlight graduations
86 ;; in the `window-margins' areas.
87 ;; - `ruler-mode-fringes' the face used to highlight graduations
88 ;; in the `window-fringes' areas.
89 ;; - `ruler-mode-column-number' the face used to highlight the
90 ;; numbered graduations.
92 ;; `ruler-mode-default' inherits from the built-in `default' face.
93 ;; All `ruler-mode' faces inherit from `ruler-mode-default'.
95 ;; WARNING: To keep ruler graduations aligned on text columns it is
96 ;; important to use the same font family and size for ruler and text
97 ;; areas.
99 ;; You can override the ruler format by defining an appropriate
100 ;; function as the buffer-local value of `ruler-mode-ruler-function'.
102 ;; Installation
104 ;; To automatically display the ruler in specific major modes use:
106 ;; (add-hook '<major-mode>-hook 'ruler-mode)
109 ;;; History:
112 ;;; Code:
113 (eval-when-compile
114 (require 'wid-edit))
115 (require 'scroll-bar)
116 (require 'fringe)
118 (defgroup ruler-mode nil
119 "Display a ruler in the header line."
120 :version "22.1"
121 :group 'convenience)
123 (defcustom ruler-mode-show-tab-stops nil
124 "*If non-nil the ruler shows tab stop positions.
125 Also allowing to visually change `tab-stop-list' setting using
126 <C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
127 or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
128 <C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
129 :group 'ruler-mode
130 :type 'boolean)
132 ;; IMPORTANT: This function must be defined before the following
133 ;; defcustoms because it is used in their :validate clause.
134 (defun ruler-mode-character-validate (widget)
135 "Ensure WIDGET value is a valid character value."
136 (save-excursion
137 (let ((value (widget-value widget)))
138 (unless (characterp value)
139 (widget-put widget :error
140 (format "Invalid character value: %S" value))
141 widget))))
143 (defcustom ruler-mode-fill-column-char (if (char-displayable-p)
144 ?\¶
145 ?\|)
146 "*Character used at the `fill-column' location."
147 :group 'ruler-mode
148 :type '(choice
149 (character :tag "Character")
150 (integer :tag "Integer char value"
151 :validate ruler-mode-character-validate)))
153 (defcustom ruler-mode-comment-column-char ?\#
154 "*Character used at the `comment-column' location."
155 :group 'ruler-mode
156 :type '(choice
157 (character :tag "Character")
158 (integer :tag "Integer char value"
159 :validate ruler-mode-character-validate)))
161 (defcustom ruler-mode-goal-column-char ?G
162 "*Character used at the `goal-column' location."
163 :group 'ruler-mode
164 :type '(choice
165 (character :tag "Character")
166 (integer :tag "Integer char value"
167 :validate ruler-mode-character-validate)))
169 (defcustom ruler-mode-current-column-char (if (char-displayable-p)
170 ?\¦
171 ?\@)
172 "*Character used at the `current-column' location."
173 :group 'ruler-mode
174 :type '(choice
175 (character :tag "Character")
176 (integer :tag "Integer char value"
177 :validate ruler-mode-character-validate)))
179 (defcustom ruler-mode-tab-stop-char ?\T
180 "*Character used at `tab-stop-list' locations."
181 :group 'ruler-mode
182 :type '(choice
183 (character :tag "Character")
184 (integer :tag "Integer char value"
185 :validate ruler-mode-character-validate)))
187 (defcustom ruler-mode-basic-graduation-char ?\.
188 "*Character used for basic graduations."
189 :group 'ruler-mode
190 :type '(choice
191 (character :tag "Character")
192 (integer :tag "Integer char value"
193 :validate ruler-mode-character-validate)))
195 (defcustom ruler-mode-inter-graduation-char ?\!
196 "*Character used for intermediate graduations."
197 :group 'ruler-mode
198 :type '(choice
199 (character :tag "Character")
200 (integer :tag "Integer char value"
201 :validate ruler-mode-character-validate)))
203 (defcustom ruler-mode-set-goal-column-ding-flag t
204 "*Non-nil means do `ding' when `goal-column' is set."
205 :group 'ruler-mode
206 :type 'boolean)
208 (defface ruler-mode-default
209 '((((type tty))
210 (:inherit default
211 :background "grey64"
212 :foreground "grey50"
215 (:inherit default
216 :background "grey76"
217 :foreground "grey64"
218 :box (:color "grey76"
219 :line-width 1
220 :style released-button)
222 "Default face used by the ruler."
223 :group 'ruler-mode)
225 (defface ruler-mode-pad
226 '((((type tty))
227 (:inherit ruler-mode-default
228 :background "grey50"
231 (:inherit ruler-mode-default
232 :background "grey64"
234 "Face used to pad inactive ruler areas."
235 :group 'ruler-mode)
237 (defface ruler-mode-margins
238 '((t
239 (:inherit ruler-mode-default
240 :foreground "white"
242 "Face used to highlight margin areas."
243 :group 'ruler-mode)
245 (defface ruler-mode-fringes
246 '((t
247 (:inherit ruler-mode-default
248 :foreground "green"
250 "Face used to highlight fringes areas."
251 :group 'ruler-mode)
253 (defface ruler-mode-column-number
254 '((t
255 (:inherit ruler-mode-default
256 :foreground "black"
258 "Face used to highlight number graduations."
259 :group 'ruler-mode)
261 (defface ruler-mode-fill-column
262 '((t
263 (:inherit ruler-mode-default
264 :foreground "red"
266 "Face used to highlight the fill column character."
267 :group 'ruler-mode)
269 (defface ruler-mode-comment-column
270 '((t
271 (:inherit ruler-mode-default
272 :foreground "red"
274 "Face used to highlight the comment column character."
275 :group 'ruler-mode)
277 (defface ruler-mode-goal-column
278 '((t
279 (:inherit ruler-mode-default
280 :foreground "red"
282 "Face used to highlight the goal column character."
283 :group 'ruler-mode)
285 (defface ruler-mode-tab-stop
286 '((t
287 (:inherit ruler-mode-default
288 :foreground "steelblue"
290 "Face used to highlight tab stop characters."
291 :group 'ruler-mode)
293 (defface ruler-mode-current-column
294 '((t
295 (:inherit ruler-mode-default
296 :weight bold
297 :foreground "yellow"
299 "Face used to highlight the `current-column' character."
300 :group 'ruler-mode)
303 (defsubst ruler-mode-full-window-width ()
304 "Return the full width of the selected window."
305 (let ((edges (window-edges)))
306 (- (nth 2 edges) (nth 0 edges))))
308 (defsubst ruler-mode-window-col (n)
309 "Return a column number relative to the selected window.
310 N is a column number relative to selected frame."
311 (- n
312 (car (window-edges))
313 (or (car (window-margins)) 0)
314 (fringe-columns 'left)
315 (scroll-bar-columns 'left)))
317 (defun ruler-mode-mouse-set-left-margin (start-event)
318 "Set left margin end to the graduation where the mouse pointer is on.
319 START-EVENT is the mouse click event."
320 (interactive "e")
321 (let* ((start (event-start start-event))
322 (end (event-end start-event))
323 col w lm rm)
324 (when (eq start end) ;; mouse click
325 (save-selected-window
326 (select-window (posn-window start))
327 (setq col (- (car (posn-col-row start)) (car (window-edges))
328 (scroll-bar-columns 'left))
329 w (- (ruler-mode-full-window-width)
330 (scroll-bar-columns 'left)
331 (scroll-bar-columns 'right)))
332 (when (and (>= col 0) (< col w))
333 (setq lm (window-margins)
334 rm (or (cdr lm) 0)
335 lm (or (car lm) 0))
336 (message "Left margin set to %d (was %d)" col lm)
337 (set-window-margins nil col rm))))))
339 (defun ruler-mode-mouse-set-right-margin (start-event)
340 "Set right margin beginning to the graduation where the mouse pointer is on.
341 START-EVENT is the mouse click event."
342 (interactive "e")
343 (let* ((start (event-start start-event))
344 (end (event-end start-event))
345 col w lm rm)
346 (when (eq start end) ;; mouse click
347 (save-selected-window
348 (select-window (posn-window start))
349 (setq col (- (car (posn-col-row start)) (car (window-edges))
350 (scroll-bar-columns 'left))
351 w (- (ruler-mode-full-window-width)
352 (scroll-bar-columns 'left)
353 (scroll-bar-columns 'right)))
354 (when (and (>= col 0) (< col w))
355 (setq lm (window-margins)
356 rm (or (cdr lm) 0)
357 lm (or (car lm) 0)
358 col (- w col 1))
359 (message "Right margin set to %d (was %d)" col rm)
360 (set-window-margins nil lm col))))))
362 (defvar ruler-mode-dragged-symbol nil
363 "Column symbol dragged in the ruler.
364 That is `fill-column', `comment-column', `goal-column', or nil when
365 nothing is dragged.")
367 (defun ruler-mode-mouse-grab-any-column (start-event)
368 "Drag a column symbol on the ruler.
369 Start dragging on mouse down event START-EVENT, and update the column
370 symbol value with the current value of the ruler graduation while
371 dragging. See also the variable `ruler-mode-dragged-symbol'."
372 (interactive "e")
373 (setq ruler-mode-dragged-symbol nil)
374 (let* ((start (event-start start-event))
375 col newc oldc)
376 (save-selected-window
377 (select-window (posn-window start))
378 (setq col (ruler-mode-window-col (car (posn-col-row start)))
379 newc (+ col (window-hscroll)))
380 (and
381 (>= col 0) (< col (window-width))
382 (cond
384 ;; Handle the fill column.
385 ((eq newc fill-column)
386 (setq oldc fill-column
387 ruler-mode-dragged-symbol 'fill-column)
388 t) ;; Start dragging
390 ;; Handle the comment column.
391 ((eq newc comment-column)
392 (setq oldc comment-column
393 ruler-mode-dragged-symbol 'comment-column)
394 t) ;; Start dragging
396 ;; Handle the goal column.
397 ;; A. On mouse down on the goal column character on the ruler,
398 ;; update the `goal-column' value while dragging.
399 ;; B. If `goal-column' is nil, set the goal column where the
400 ;; mouse is clicked.
401 ;; C. On mouse click on the goal column character on the
402 ;; ruler, unset the goal column.
403 ((eq newc goal-column) ; A. Drag the goal column.
404 (setq oldc goal-column
405 ruler-mode-dragged-symbol 'goal-column)
406 t) ;; Start dragging
408 ((null goal-column) ; B. Set the goal column.
409 (setq oldc goal-column
410 goal-column newc)
411 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
412 ;; `ding' flushes the next messages about setting goal
413 ;; column. So here I force fetch the event(mouse-2) and
414 ;; throw away.
415 (read-event)
416 ;; Ding BEFORE `message' is OK.
417 (when ruler-mode-set-goal-column-ding-flag
418 (ding))
419 (message "Goal column set to %d (click on %s again to unset it)"
420 newc
421 (propertize (char-to-string ruler-mode-goal-column-char)
422 'face 'ruler-mode-goal-column))
423 nil) ;; Don't start dragging.
425 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
426 (posn-window start)))
427 (when (eq 'goal-column ruler-mode-dragged-symbol)
428 ;; C. Unset the goal column.
429 (set-goal-column t))
430 ;; At end of dragging, report the updated column symbol.
431 (message "%s is set to %d (was %d)"
432 ruler-mode-dragged-symbol
433 (symbol-value ruler-mode-dragged-symbol)
434 oldc))))))
436 (defun ruler-mode-mouse-drag-any-column-iteration (window)
437 "Update the ruler while dragging the mouse.
438 WINDOW is the window where occurred the last down-mouse event.
439 Return the symbol `drag' if the mouse has been dragged, or `click' if
440 the mouse has been clicked."
441 (let ((drags 0)
442 event)
443 (track-mouse
444 (while (mouse-movement-p (setq event (read-event)))
445 (setq drags (1+ drags))
446 (when (eq window (posn-window (event-end event)))
447 (ruler-mode-mouse-drag-any-column event)
448 (force-mode-line-update))))
449 (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
450 'click
451 'drag)))
453 (defun ruler-mode-mouse-drag-any-column (start-event)
454 "Update the value of the symbol dragged on the ruler.
455 Called on each mouse motion event START-EVENT."
456 (let* ((start (event-start start-event))
457 (end (event-end start-event))
458 col newc)
459 (save-selected-window
460 (select-window (posn-window start))
461 (setq col (ruler-mode-window-col (car (posn-col-row end)))
462 newc (+ col (window-hscroll)))
463 (when (and (>= col 0) (< col (window-width)))
464 (set ruler-mode-dragged-symbol newc)))))
466 (defun ruler-mode-mouse-add-tab-stop (start-event)
467 "Add a tab stop to the graduation where the mouse pointer is on.
468 START-EVENT is the mouse click event."
469 (interactive "e")
470 (when ruler-mode-show-tab-stops
471 (let* ((start (event-start start-event))
472 (end (event-end start-event))
473 col ts)
474 (when (eq start end) ;; mouse click
475 (save-selected-window
476 (select-window (posn-window start))
477 (setq col (ruler-mode-window-col (car (posn-col-row start)))
478 ts (+ col (window-hscroll)))
479 (and (>= col 0) (< col (window-width))
480 (not (member ts tab-stop-list))
481 (progn
482 (message "Tab stop set to %d" ts)
483 (setq tab-stop-list (sort (cons ts tab-stop-list)
484 #'<)))))))))
486 (defun ruler-mode-mouse-del-tab-stop (start-event)
487 "Delete tab stop at the graduation where the mouse pointer is on.
488 START-EVENT is the mouse click event."
489 (interactive "e")
490 (when ruler-mode-show-tab-stops
491 (let* ((start (event-start start-event))
492 (end (event-end start-event))
493 col ts)
494 (when (eq start end) ;; mouse click
495 (save-selected-window
496 (select-window (posn-window start))
497 (setq col (ruler-mode-window-col (car (posn-col-row start)))
498 ts (+ col (window-hscroll)))
499 (and (>= col 0) (< col (window-width))
500 (member ts tab-stop-list)
501 (progn
502 (message "Tab stop at %d deleted" ts)
503 (setq tab-stop-list (delete ts tab-stop-list)))))))))
505 (defun ruler-mode-toggle-show-tab-stops ()
506 "Toggle showing of tab stops on the ruler."
507 (interactive)
508 (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
509 (force-mode-line-update))
511 (defvar ruler-mode-map
512 (let ((km (make-sparse-keymap)))
513 (define-key km [header-line down-mouse-1]
514 #'ignore)
515 (define-key km [header-line down-mouse-3]
516 #'ignore)
517 (define-key km [header-line down-mouse-2]
518 #'ruler-mode-mouse-grab-any-column)
519 (define-key km [header-line (shift down-mouse-1)]
520 #'ruler-mode-mouse-set-left-margin)
521 (define-key km [header-line (shift down-mouse-3)]
522 #'ruler-mode-mouse-set-right-margin)
523 (define-key km [header-line (control down-mouse-1)]
524 #'ruler-mode-mouse-add-tab-stop)
525 (define-key km [header-line (control down-mouse-3)]
526 #'ruler-mode-mouse-del-tab-stop)
527 (define-key km [header-line (control down-mouse-2)]
528 #'ruler-mode-toggle-show-tab-stops)
529 (define-key km [header-line (shift mouse-1)]
530 'ignore)
531 (define-key km [header-line (shift mouse-3)]
532 'ignore)
533 (define-key km [header-line (control mouse-1)]
534 'ignore)
535 (define-key km [header-line (control mouse-3)]
536 'ignore)
537 (define-key km [header-line (control mouse-2)]
538 'ignore)
540 "Keymap for ruler minor mode.")
542 (defvar ruler-mode-header-line-format-old nil
543 "Hold previous value of `header-line-format'.")
545 (defvar ruler-mode-ruler-function 'ruler-mode-ruler
546 "Function to call to return ruler header line format.
547 This variable is expected to be made buffer-local by modes.")
549 (defconst ruler-mode-header-line-format
550 '(:eval (funcall ruler-mode-ruler-function))
551 "`header-line-format' used in ruler mode.
552 Call `ruler-mode-ruler-function' to compute the ruler value.")
554 ;;;###autoload
555 (define-minor-mode ruler-mode
556 "Display a ruler in the header line if ARG > 0."
557 nil nil
558 ruler-mode-map
559 :group 'ruler-mode
560 (if ruler-mode
561 (progn
562 ;; When `ruler-mode' is on save previous header line format
563 ;; and install the ruler header line format.
564 (when (and (local-variable-p 'header-line-format)
565 (not (local-variable-p 'ruler-mode-header-line-format-old)))
566 (set (make-local-variable 'ruler-mode-header-line-format-old)
567 header-line-format))
568 (setq header-line-format ruler-mode-header-line-format)
569 (add-hook 'post-command-hook 'force-mode-line-update nil t))
570 ;; When `ruler-mode' is off restore previous header line format if
571 ;; the current one is the ruler header line format.
572 (when (eq header-line-format ruler-mode-header-line-format)
573 (kill-local-variable 'header-line-format)
574 (when (local-variable-p 'ruler-mode-header-line-format-old)
575 (setq header-line-format ruler-mode-header-line-format-old)
576 (kill-local-variable 'ruler-mode-header-line-format-old)))
577 (remove-hook 'post-command-hook 'force-mode-line-update t)))
579 ;; Add ruler-mode to the minor mode menu in the mode line
580 (define-key mode-line-mode-menu [ruler-mode]
581 `(menu-item "Ruler" ruler-mode
582 :button (:toggle . ruler-mode)))
584 (defconst ruler-mode-ruler-help-echo
586 S-mouse-1/3: set L/R margin, \
587 mouse-2: set goal column, \
588 C-mouse-2: show tabs"
589 "Help string shown when mouse is over the ruler.
590 `ruler-mode-show-tab-stops' is nil.")
592 (defconst ruler-mode-ruler-help-echo-when-goal-column
594 S-mouse-1/3: set L/R margin, \
595 C-mouse-2: show tabs"
596 "Help string shown when mouse is over the ruler.
597 `goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
599 (defconst ruler-mode-ruler-help-echo-when-tab-stops
601 C-mouse1/3: set/unset tab, \
602 C-mouse-2: hide tabs"
603 "Help string shown when mouse is over the ruler.
604 `ruler-mode-show-tab-stops' is non-nil.")
606 (defconst ruler-mode-fill-column-help-echo
607 "drag-mouse-2: set fill column"
608 "Help string shown when mouse is on the fill column character.")
610 (defconst ruler-mode-comment-column-help-echo
611 "drag-mouse-2: set comment column"
612 "Help string shown when mouse is on the comment column character.")
614 (defconst ruler-mode-goal-column-help-echo
616 drag-mouse-2: set goal column, \
617 mouse-2: unset goal column"
618 "Help string shown when mouse is on the goal column character.")
620 (defconst ruler-mode-margin-help-echo
621 "%s margin %S"
622 "Help string shown when mouse is over a margin area.")
624 (defconst ruler-mode-fringe-help-echo
625 "%s fringe %S"
626 "Help string shown when mouse is over a fringe area.")
628 (defsubst ruler-mode-space (width &rest props)
629 "Return a single space string of WIDTH times the normal character width.
630 Optional argument PROPS specifies other text properties to apply."
631 (apply 'propertize " " 'display (list 'space :width width) props))
633 (defun ruler-mode-ruler ()
634 "Compute and return a header line ruler."
635 (let* ((w (window-width))
636 (m (window-margins))
637 (f (window-fringes))
638 (i 0)
639 (j (window-hscroll))
640 ;; Setup the scrollbar, fringes, and margins areas.
641 (lf (ruler-mode-space
642 'left-fringe
643 'face 'ruler-mode-fringes
644 'help-echo (format ruler-mode-fringe-help-echo
645 "Left" (or (car f) 0))))
646 (rf (ruler-mode-space
647 'right-fringe
648 'face 'ruler-mode-fringes
649 'help-echo (format ruler-mode-fringe-help-echo
650 "Right" (or (cadr f) 0))))
651 (lm (ruler-mode-space
652 'left-margin
653 'face 'ruler-mode-margins
654 'help-echo (format ruler-mode-margin-help-echo
655 "Left" (or (car m) 0))))
656 (rm (ruler-mode-space
657 'right-margin
658 'face 'ruler-mode-margins
659 'help-echo (format ruler-mode-margin-help-echo
660 "Right" (or (cdr m) 0))))
661 (sb (ruler-mode-space
662 'scroll-bar
663 'face 'ruler-mode-pad))
664 ;; Remember the scrollbar vertical type.
665 (sbvt (car (window-current-scroll-bars)))
666 ;; Create an "clean" ruler.
667 (ruler
668 (propertize
669 (string-to-multibyte
670 (make-string w ruler-mode-basic-graduation-char))
671 'face 'ruler-mode-default
672 'local-map ruler-mode-map
673 'help-echo (cond
674 (ruler-mode-show-tab-stops
675 ruler-mode-ruler-help-echo-when-tab-stops)
676 (goal-column
677 ruler-mode-ruler-help-echo-when-goal-column)
678 (ruler-mode-ruler-help-echo))))
679 k c)
680 ;; Setup the active area.
681 (while (< i w)
682 ;; Graduations.
683 (cond
684 ;; Show a number graduation.
685 ((= (mod j 10) 0)
686 (setq c (number-to-string (/ j 10))
687 m (length c)
688 k i)
689 (put-text-property
690 i (1+ i) 'face 'ruler-mode-column-number
691 ruler)
692 (while (and (> m 0) (>= k 0))
693 (aset ruler k (aref c (setq m (1- m))))
694 (setq k (1- k))))
695 ;; Show an intermediate graduation.
696 ((= (mod j 5) 0)
697 (aset ruler i ruler-mode-inter-graduation-char)))
698 ;; Special columns.
699 (cond
700 ;; Show the `current-column' marker.
701 ((= j (current-column))
702 (aset ruler i ruler-mode-current-column-char)
703 (put-text-property
704 i (1+ i) 'face 'ruler-mode-current-column
705 ruler))
706 ;; Show the `goal-column' marker.
707 ((and goal-column (= j goal-column))
708 (aset ruler i ruler-mode-goal-column-char)
709 (put-text-property
710 i (1+ i) 'face 'ruler-mode-goal-column
711 ruler)
712 (put-text-property
713 i (1+ i) 'mouse-face 'mode-line-highlight
714 ruler)
715 (put-text-property
716 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
717 ruler))
718 ;; Show the `comment-column' marker.
719 ((= j comment-column)
720 (aset ruler i ruler-mode-comment-column-char)
721 (put-text-property
722 i (1+ i) 'face 'ruler-mode-comment-column
723 ruler)
724 (put-text-property
725 i (1+ i) 'mouse-face 'mode-line-highlight
726 ruler)
727 (put-text-property
728 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
729 ruler))
730 ;; Show the `fill-column' marker.
731 ((= j fill-column)
732 (aset ruler i ruler-mode-fill-column-char)
733 (put-text-property
734 i (1+ i) 'face 'ruler-mode-fill-column
735 ruler)
736 (put-text-property
737 i (1+ i) 'mouse-face 'mode-line-highlight
738 ruler)
739 (put-text-property
740 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
741 ruler))
742 ;; Show the `tab-stop-list' markers.
743 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
744 (aset ruler i ruler-mode-tab-stop-char)
745 (put-text-property
746 i (1+ i) 'face 'ruler-mode-tab-stop
747 ruler)))
748 (setq i (1+ i)
749 j (1+ j)))
750 ;; Return the ruler propertized string. Using list here,
751 ;; instead of concat visually separate the different areas.
752 (if (nth 2 (window-fringes))
753 ;; fringes outside margins.
754 (list "" (and (eq 'left sbvt) sb) lf lm
755 ruler rm rf (and (eq 'right sbvt) sb))
756 ;; fringes inside margins.
757 (list "" (and (eq 'left sbvt) sb) lm lf
758 ruler rf rm (and (eq 'right sbvt) sb)))))
760 (provide 'ruler-mode)
762 ;; Local Variables:
763 ;; coding: iso-latin-1
764 ;; End:
766 ;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
767 ;;; ruler-mode.el ends here