(elint-check-defcustom-form): Don't use `evenp' so we don't implicitly
[emacs.git] / lisp / ruler-mode.el
blob7673802fdfa045cb2bcc67b896676595a3a6f7c9
1 ;;; ruler-mode.el --- display a ruler in the header line
3 ;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
5 ;; Author: David Ponce <david@dponce.com>
6 ;; Maintainer: David Ponce <david@dponce.com>
7 ;; Created: 24 Mar 2001
8 ;; Version: 1.6
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., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
28 ;;; Commentary:
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-face' the ruler default face.
74 ;; - `ruler-mode-fill-column-face' the face used to highlight the
75 ;; `fill-column' character.
76 ;; - `ruler-mode-comment-column-face' the face used to highlight the
77 ;; `comment-column' character.
78 ;; - `ruler-mode-goal-column-face' the face used to highlight the
79 ;; `goal-column' character.
80 ;; - `ruler-mode-current-column-face' the face used to highlight the
81 ;; `current-column' character.
82 ;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
83 ;; characters.
84 ;; - `ruler-mode-margins-face' the face used to highlight graduations
85 ;; in the `window-margins' areas.
86 ;; - `ruler-mode-fringes-face' the face used to highlight graduations
87 ;; in the `window-fringes' areas.
88 ;; - `ruler-mode-column-number-face' the face used to highlight the
89 ;; numbered graduations.
91 ;; `ruler-mode-default-face' inherits from the built-in `default' face.
92 ;; All `ruler-mode' faces inherit from `ruler-mode-default-face'.
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
96 ;; areas.
98 ;; Installation
100 ;; To automatically display the ruler in specific major modes use:
102 ;; (add-hook '<major-mode>-hook 'ruler-mode)
105 ;;; History:
108 ;;; Code:
109 (eval-when-compile
110 (require 'wid-edit))
112 (defgroup ruler-mode nil
113 "Display a ruler in the header line."
114 :version "21.4"
115 :group 'convenience)
117 (defcustom ruler-mode-show-tab-stops nil
118 "*If non-nil the ruler shows tab stop positions.
119 Also allowing to visually change `tab-stop-list' setting using
120 <C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
121 or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
122 <C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
123 :group 'ruler-mode
124 :type 'boolean)
126 ;; IMPORTANT: This function must be defined before the following
127 ;; defcustoms because it is used in their :validate clause.
128 (defun ruler-mode-character-validate (widget)
129 "Ensure WIDGET value is a valid character value."
130 (save-excursion
131 (let ((value (widget-value widget)))
132 (if (char-valid-p value)
134 (widget-put widget :error
135 (format "Invalid character value: %S" value))
136 widget))))
138 (defcustom ruler-mode-fill-column-char (if (char-displayable-p)
139 ?\¶
140 ?\|)
141 "*Character used at the `fill-column' location."
142 :group 'ruler-mode
143 :type '(choice
144 (character :tag "Character")
145 (integer :tag "Integer char value"
146 :validate ruler-mode-character-validate)))
148 (defcustom ruler-mode-comment-column-char ?\#
149 "*Character used at the `comment-column' location."
150 :group 'ruler-mode
151 :type '(choice
152 (character :tag "Character")
153 (integer :tag "Integer char value"
154 :validate ruler-mode-character-validate)))
156 (defcustom ruler-mode-goal-column-char ?G
157 "*Character used at the `goal-column' location."
158 :group 'ruler-mode
159 :type '(choice
160 (character :tag "Character")
161 (integer :tag "Integer char value"
162 :validate ruler-mode-character-validate)))
164 (defcustom ruler-mode-current-column-char (if (char-displayable-p)
165 ?\¦
166 ?\@)
167 "*Character used at the `current-column' location."
168 :group 'ruler-mode
169 :type '(choice
170 (character :tag "Character")
171 (integer :tag "Integer char value"
172 :validate ruler-mode-character-validate)))
174 (defcustom ruler-mode-tab-stop-char ?\T
175 "*Character used at `tab-stop-list' locations."
176 :group 'ruler-mode
177 :type '(choice
178 (character :tag "Character")
179 (integer :tag "Integer char value"
180 :validate ruler-mode-character-validate)))
182 (defcustom ruler-mode-basic-graduation-char ?\.
183 "*Character used for basic graduations."
184 :group 'ruler-mode
185 :type '(choice
186 (character :tag "Character")
187 (integer :tag "Integer char value"
188 :validate ruler-mode-character-validate)))
190 (defcustom ruler-mode-inter-graduation-char ?\!
191 "*Character used for intermediate graduations."
192 :group 'ruler-mode
193 :type '(choice
194 (character :tag "Character")
195 (integer :tag "Integer char value"
196 :validate ruler-mode-character-validate)))
198 (defcustom ruler-mode-set-goal-column-ding-flag t
199 "*Non-nil means do `ding' when `goal-column' is set."
200 :group 'ruler-mode
201 :type 'boolean)
203 (defface ruler-mode-default-face
204 '((((type tty))
205 (:inherit default
206 :background "grey64"
207 :foreground "grey50"
210 (:inherit default
211 :background "grey76"
212 :foreground "grey64"
213 :box (:color "grey76"
214 :line-width 1
215 :style released-button)
217 "Default face used by the ruler."
218 :group 'ruler-mode)
220 (defface ruler-mode-pad-face
221 '((((type tty))
222 (:inherit ruler-mode-default-face
223 :background "grey50"
226 (:inherit ruler-mode-default-face
227 :background "grey64"
229 "Face used to pad inactive ruler areas."
230 :group 'ruler-mode)
232 (defface ruler-mode-margins-face
233 '((t
234 (:inherit ruler-mode-default-face
235 :foreground "white"
237 "Face used to highlight margin areas."
238 :group 'ruler-mode)
240 (defface ruler-mode-fringes-face
241 '((t
242 (:inherit ruler-mode-default-face
243 :foreground "green"
245 "Face used to highlight fringes areas."
246 :group 'ruler-mode)
248 (defface ruler-mode-column-number-face
249 '((t
250 (:inherit ruler-mode-default-face
251 :foreground "black"
253 "Face used to highlight number graduations."
254 :group 'ruler-mode)
256 (defface ruler-mode-fill-column-face
257 '((t
258 (:inherit ruler-mode-default-face
259 :foreground "red"
261 "Face used to highlight the fill column character."
262 :group 'ruler-mode)
264 (defface ruler-mode-comment-column-face
265 '((t
266 (:inherit ruler-mode-default-face
267 :foreground "red"
269 "Face used to highlight the comment column character."
270 :group 'ruler-mode)
272 (defface ruler-mode-goal-column-face
273 '((t
274 (:inherit ruler-mode-default-face
275 :foreground "red"
277 "Face used to highlight the goal column character."
278 :group 'ruler-mode)
280 (defface ruler-mode-tab-stop-face
281 '((t
282 (:inherit ruler-mode-default-face
283 :foreground "steelblue"
285 "Face used to highlight tab stop characters."
286 :group 'ruler-mode)
288 (defface ruler-mode-current-column-face
289 '((t
290 (:inherit ruler-mode-default-face
291 :weight bold
292 :foreground "yellow"
294 "Face used to highlight the `current-column' character."
295 :group 'ruler-mode)
297 (defmacro ruler-mode-left-fringe-cols ()
298 "Return the width, measured in columns, of the left fringe area."
299 '(ceiling (or (car (window-fringes)) 0)
300 (frame-char-width)))
302 (defmacro ruler-mode-right-fringe-cols ()
303 "Return the width, measured in columns, of the right fringe area."
304 '(ceiling (or (nth 1 (window-fringes)) 0)
305 (frame-char-width)))
307 (defun ruler-mode-left-scroll-bar-cols ()
308 "Return the width, measured in columns, of the right vertical scrollbar."
309 (let* ((wsb (window-scroll-bars))
310 (vtype (nth 2 wsb))
311 (cols (nth 1 wsb)))
312 (if (or (eq vtype 'left)
313 (and (eq vtype t)
314 (eq (frame-parameter nil 'vertical-scroll-bars) 'left)))
315 (or cols
316 (ceiling
317 ;; nil means it's a non-toolkit scroll bar,
318 ;; and its width in columns is 14 pixels rounded up.
319 (or (frame-parameter nil 'scroll-bar-width) 14)
320 ;; Always round up to multiple of columns.
321 (frame-char-width)))
322 0)))
324 (defun ruler-mode-right-scroll-bar-cols ()
325 "Return the width, measured in columns, of the right vertical scrollbar."
326 (let* ((wsb (window-scroll-bars))
327 (vtype (nth 2 wsb))
328 (cols (nth 1 wsb)))
329 (if (or (eq vtype 'right)
330 (and (eq vtype t)
331 (eq (frame-parameter nil 'vertical-scroll-bars) 'right)))
332 (or cols
333 (ceiling
334 ;; nil means it's a non-toolkit scroll bar,
335 ;; and its width in columns is 14 pixels rounded up.
336 (or (frame-parameter nil 'scroll-bar-width) 14)
337 ;; Always round up to multiple of columns.
338 (frame-char-width)))
339 0)))
341 (defsubst ruler-mode-full-window-width ()
342 "Return the full width of the selected window."
343 (let ((edges (window-edges)))
344 (- (nth 2 edges) (nth 0 edges))))
346 (defsubst ruler-mode-window-col (n)
347 "Return a column number relative to the selected window.
348 N is a column number relative to selected frame."
349 (- n
350 (car (window-edges))
351 (or (car (window-margins)) 0)
352 (ruler-mode-left-fringe-cols)
353 (ruler-mode-left-scroll-bar-cols)))
355 (defun ruler-mode-mouse-set-left-margin (start-event)
356 "Set left margin end to the graduation where the mouse pointer is on.
357 START-EVENT is the mouse click event."
358 (interactive "e")
359 (let* ((start (event-start start-event))
360 (end (event-end start-event))
361 col w lm rm)
362 (when (eq start end) ;; mouse click
363 (save-selected-window
364 (select-window (posn-window start))
365 (setq col (- (car (posn-col-row start)) (car (window-edges))
366 (ruler-mode-left-scroll-bar-cols))
367 w (- (ruler-mode-full-window-width)
368 (ruler-mode-left-scroll-bar-cols)
369 (ruler-mode-right-scroll-bar-cols)))
370 (when (and (>= col 0) (< col w))
371 (setq lm (window-margins)
372 rm (or (cdr lm) 0)
373 lm (or (car lm) 0))
374 (message "Left margin set to %d (was %d)" col lm)
375 (set-window-margins nil col rm))))))
377 (defun ruler-mode-mouse-set-right-margin (start-event)
378 "Set right margin beginning to the graduation where the mouse pointer is on.
379 START-EVENT is the mouse click event."
380 (interactive "e")
381 (let* ((start (event-start start-event))
382 (end (event-end start-event))
383 col w lm rm)
384 (when (eq start end) ;; mouse click
385 (save-selected-window
386 (select-window (posn-window start))
387 (setq col (- (car (posn-col-row start)) (car (window-edges))
388 (ruler-mode-left-scroll-bar-cols))
389 w (- (ruler-mode-full-window-width)
390 (ruler-mode-left-scroll-bar-cols)
391 (ruler-mode-right-scroll-bar-cols)))
392 (when (and (>= col 0) (< col w))
393 (setq lm (window-margins)
394 rm (or (cdr lm) 0)
395 lm (or (car lm) 0)
396 col (- w col 1))
397 (message "Right margin set to %d (was %d)" col rm)
398 (set-window-margins nil lm col))))))
400 (defvar ruler-mode-dragged-symbol nil
401 "Column symbol dragged in the ruler.
402 That is `fill-column', `comment-column', `goal-column', or nil when
403 nothing is dragged.")
405 (defun ruler-mode-mouse-grab-any-column (start-event)
406 "Drag a column symbol on the ruler.
407 Start dragging on mouse down event START-EVENT, and update the column
408 symbol value with the current value of the ruler graduation while
409 dragging. See also the variable `ruler-mode-dragged-symbol'."
410 (interactive "e")
411 (setq ruler-mode-dragged-symbol nil)
412 (let* ((start (event-start start-event))
413 col newc oldc)
414 (save-selected-window
415 (select-window (posn-window start))
416 (setq col (ruler-mode-window-col (car (posn-col-row start)))
417 newc (+ col (window-hscroll)))
418 (and
419 (>= col 0) (< col (window-width))
420 (cond
422 ;; Handle the fill column.
423 ((eq newc fill-column)
424 (setq oldc fill-column
425 ruler-mode-dragged-symbol 'fill-column)
426 t) ;; Start dragging
428 ;; Handle the comment column.
429 ((eq newc comment-column)
430 (setq oldc comment-column
431 ruler-mode-dragged-symbol 'comment-column)
432 t) ;; Start dragging
434 ;; Handle the goal column.
435 ;; A. On mouse down on the goal column character on the ruler,
436 ;; update the `goal-column' value while dragging.
437 ;; B. If `goal-column' is nil, set the goal column where the
438 ;; mouse is clicked.
439 ;; C. On mouse click on the goal column character on the
440 ;; ruler, unset the goal column.
441 ((eq newc goal-column) ; A. Drag the goal column.
442 (setq oldc goal-column
443 ruler-mode-dragged-symbol 'goal-column)
444 t) ;; Start dragging
446 ((null goal-column) ; B. Set the goal column.
447 (setq oldc goal-column
448 goal-column newc)
449 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
450 ;; `ding' flushes the next messages about setting goal
451 ;; column. So here I force fetch the event(mouse-2) and
452 ;; throw away.
453 (read-event)
454 ;; Ding BEFORE `message' is OK.
455 (when ruler-mode-set-goal-column-ding-flag
456 (ding))
457 (message "Goal column set to %d (click on %s again to unset it)"
458 newc
459 (propertize (char-to-string ruler-mode-goal-column-char)
460 'face 'ruler-mode-goal-column-face))
461 nil) ;; Don't start dragging.
463 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
464 (posn-window start)))
465 (when (eq 'goal-column ruler-mode-dragged-symbol)
466 ;; C. Unset the goal column.
467 (set-goal-column t))
468 ;; At end of dragging, report the updated column symbol.
469 (message "%s is set to %d (was %d)"
470 ruler-mode-dragged-symbol
471 (symbol-value ruler-mode-dragged-symbol)
472 oldc))))))
474 (defun ruler-mode-mouse-drag-any-column-iteration (window)
475 "Update the ruler while dragging the mouse.
476 WINDOW is the window where occurred the last down-mouse event.
477 Return the symbol `drag' if the mouse has been dragged, or `click' if
478 the mouse has been clicked."
479 (let ((drags 0)
480 event)
481 (track-mouse
482 (while (mouse-movement-p (setq event (read-event)))
483 (setq drags (1+ drags))
484 (when (eq window (posn-window (event-end event)))
485 (ruler-mode-mouse-drag-any-column event)
486 (force-mode-line-update))))
487 (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
488 'click
489 'drag)))
491 (defun ruler-mode-mouse-drag-any-column (start-event)
492 "Update the value of the symbol dragged on the ruler.
493 Called on each mouse motion event START-EVENT."
494 (let* ((start (event-start start-event))
495 (end (event-end start-event))
496 col newc)
497 (save-selected-window
498 (select-window (posn-window start))
499 (setq col (ruler-mode-window-col (car (posn-col-row end)))
500 newc (+ col (window-hscroll)))
501 (when (and (>= col 0) (< col (window-width)))
502 (set ruler-mode-dragged-symbol newc)))))
504 (defun ruler-mode-mouse-add-tab-stop (start-event)
505 "Add a tab stop to the graduation where the mouse pointer is on.
506 START-EVENT is the mouse click event."
507 (interactive "e")
508 (when ruler-mode-show-tab-stops
509 (let* ((start (event-start start-event))
510 (end (event-end start-event))
511 col ts)
512 (when (eq start end) ;; mouse click
513 (save-selected-window
514 (select-window (posn-window start))
515 (setq col (ruler-mode-window-col (car (posn-col-row start)))
516 ts (+ col (window-hscroll)))
517 (and (>= col 0) (< col (window-width))
518 (not (member ts tab-stop-list))
519 (progn
520 (message "Tab stop set to %d" ts)
521 (setq tab-stop-list (sort (cons ts tab-stop-list)
522 #'<)))))))))
524 (defun ruler-mode-mouse-del-tab-stop (start-event)
525 "Delete tab stop at the graduation where the mouse pointer is on.
526 START-EVENT is the mouse click event."
527 (interactive "e")
528 (when ruler-mode-show-tab-stops
529 (let* ((start (event-start start-event))
530 (end (event-end start-event))
531 col ts)
532 (when (eq start end) ;; mouse click
533 (save-selected-window
534 (select-window (posn-window start))
535 (setq col (ruler-mode-window-col (car (posn-col-row start)))
536 ts (+ col (window-hscroll)))
537 (and (>= col 0) (< col (window-width))
538 (member ts tab-stop-list)
539 (progn
540 (message "Tab stop at %d deleted" ts)
541 (setq tab-stop-list (delete ts tab-stop-list)))))))))
543 (defun ruler-mode-toggle-show-tab-stops ()
544 "Toggle showing of tab stops on the ruler."
545 (interactive)
546 (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
547 (force-mode-line-update))
549 (defvar ruler-mode-map
550 (let ((km (make-sparse-keymap)))
551 (define-key km [header-line down-mouse-1]
552 #'ignore)
553 (define-key km [header-line down-mouse-3]
554 #'ignore)
555 (define-key km [header-line down-mouse-2]
556 #'ruler-mode-mouse-grab-any-column)
557 (define-key km [header-line (shift down-mouse-1)]
558 #'ruler-mode-mouse-set-left-margin)
559 (define-key km [header-line (shift down-mouse-3)]
560 #'ruler-mode-mouse-set-right-margin)
561 (define-key km [header-line (control down-mouse-1)]
562 #'ruler-mode-mouse-add-tab-stop)
563 (define-key km [header-line (control down-mouse-3)]
564 #'ruler-mode-mouse-del-tab-stop)
565 (define-key km [header-line (control down-mouse-2)]
566 #'ruler-mode-toggle-show-tab-stops)
568 "Keymap for ruler minor mode.")
570 (defvar ruler-mode-header-line-format-old nil
571 "Hold previous value of `header-line-format'.")
572 (make-variable-buffer-local 'ruler-mode-header-line-format-old)
574 (defconst ruler-mode-header-line-format
575 '(:eval (ruler-mode-ruler))
576 "`header-line-format' used in ruler mode.")
578 ;;;###autoload
579 (define-minor-mode ruler-mode
580 "Display a ruler in the header line if ARG > 0."
581 nil nil
582 ruler-mode-map
583 :group 'ruler-mode
584 (if ruler-mode
585 (progn
586 ;; When `ruler-mode' is on save previous header line format
587 ;; and install the ruler header line format.
588 (when (local-variable-p 'header-line-format)
589 (setq ruler-mode-header-line-format-old header-line-format))
590 (setq header-line-format ruler-mode-header-line-format)
591 (add-hook 'post-command-hook ; add local hook
592 #'force-mode-line-update nil t))
593 ;; When `ruler-mode' is off restore previous header line format if
594 ;; the current one is the ruler header line format.
595 (when (eq header-line-format ruler-mode-header-line-format)
596 (kill-local-variable 'header-line-format)
597 (when (local-variable-p 'ruler-mode-header-line-format-old)
598 (setq header-line-format ruler-mode-header-line-format-old)))
599 (remove-hook 'post-command-hook ; remove local hook
600 #'force-mode-line-update t)))
602 ;; Add ruler-mode to the minor mode menu in the mode line
603 (define-key mode-line-mode-menu [ruler-mode]
604 `(menu-item "Ruler" ruler-mode
605 :button (:toggle . ruler-mode)))
607 (defconst ruler-mode-ruler-help-echo
609 S-mouse-1/3: set L/R margin, \
610 mouse-2: set goal column, \
611 C-mouse-2: show tabs"
612 "Help string shown when mouse is over the ruler.
613 `ruler-mode-show-tab-stops' is nil.")
615 (defconst ruler-mode-ruler-help-echo-when-goal-column
617 S-mouse-1/3: set L/R margin, \
618 C-mouse-2: show tabs"
619 "Help string shown when mouse is over the ruler.
620 `goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
622 (defconst ruler-mode-ruler-help-echo-when-tab-stops
624 C-mouse1/3: set/unset tab, \
625 C-mouse-2: hide tabs"
626 "Help string shown when mouse is over the ruler.
627 `ruler-mode-show-tab-stops' is non-nil.")
629 (defconst ruler-mode-fill-column-help-echo
630 "drag-mouse-2: set fill column"
631 "Help string shown when mouse is on the fill column character.")
633 (defconst ruler-mode-comment-column-help-echo
634 "drag-mouse-2: set comment column"
635 "Help string shown when mouse is on the comment column character.")
637 (defconst ruler-mode-goal-column-help-echo
639 drag-mouse-2: set goal column, \
640 mouse-2: unset goal column"
641 "Help string shown when mouse is on the goal column character.")
643 (defconst ruler-mode-margin-help-echo
644 "%s margin %S"
645 "Help string shown when mouse is over a margin area.")
647 (defconst ruler-mode-fringe-help-echo
648 "%s fringe %S"
649 "Help string shown when mouse is over a fringe area.")
651 (defun ruler-mode-ruler ()
652 "Return a string ruler."
653 (when ruler-mode
654 (let* ((fullw (ruler-mode-full-window-width))
655 (w (window-width))
656 (m (window-margins))
657 (lsb (ruler-mode-left-scroll-bar-cols))
658 (lf (ruler-mode-left-fringe-cols))
659 (lm (or (car m) 0))
660 (rsb (ruler-mode-right-scroll-bar-cols))
661 (rf (ruler-mode-right-fringe-cols))
662 (rm (or (cdr m) 0))
663 (ruler (make-string fullw ruler-mode-basic-graduation-char))
664 (o (+ lsb lf lm))
665 (x 0)
666 (i o)
667 (j (window-hscroll))
668 k c l1 l2 r2 r1 h1 h2 f1 f2)
670 ;; Setup the default properties.
671 (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler)
672 (put-text-property 0 fullw
673 'help-echo
674 (cond
675 (ruler-mode-show-tab-stops
676 ruler-mode-ruler-help-echo-when-tab-stops)
677 (goal-column
678 ruler-mode-ruler-help-echo-when-goal-column)
680 ruler-mode-ruler-help-echo))
681 ruler)
682 ;; Setup the local map.
683 (put-text-property 0 fullw 'local-map ruler-mode-map ruler)
685 ;; Setup the active area.
686 (while (< x w)
687 ;; Graduations.
688 (cond
689 ;; Show a number graduation.
690 ((= (mod j 10) 0)
691 (setq c (number-to-string (/ j 10))
692 m (length c)
693 k i)
694 (put-text-property
695 i (1+ i) 'face 'ruler-mode-column-number-face
696 ruler)
697 (while (and (> m 0) (>= k 0))
698 (aset ruler k (aref c (setq m (1- m))))
699 (setq k (1- k))))
700 ;; Show an intermediate graduation.
701 ((= (mod j 5) 0)
702 (aset ruler i ruler-mode-inter-graduation-char)))
703 ;; Special columns.
704 (cond
705 ;; Show the `current-column' marker.
706 ((= j (current-column))
707 (aset ruler i ruler-mode-current-column-char)
708 (put-text-property
709 i (1+ i) 'face 'ruler-mode-current-column-face
710 ruler))
711 ;; Show the `goal-column' marker.
712 ((and goal-column (= j goal-column))
713 (aset ruler i ruler-mode-goal-column-char)
714 (put-text-property
715 i (1+ i) 'face 'ruler-mode-goal-column-face
716 ruler)
717 (put-text-property
718 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
719 ruler))
720 ;; Show the `comment-column' marker.
721 ((= j comment-column)
722 (aset ruler i ruler-mode-comment-column-char)
723 (put-text-property
724 i (1+ i) 'face 'ruler-mode-comment-column-face
725 ruler)
726 (put-text-property
727 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
728 ruler))
729 ;; Show the `fill-column' marker.
730 ((= j fill-column)
731 (aset ruler i ruler-mode-fill-column-char)
732 (put-text-property
733 i (1+ i) 'face 'ruler-mode-fill-column-face
734 ruler)
735 (put-text-property
736 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
737 ruler))
738 ;; Show the `tab-stop-list' markers.
739 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
740 (aset ruler i ruler-mode-tab-stop-char)
741 (put-text-property
742 i (1+ i) 'face 'ruler-mode-tab-stop-face
743 ruler)))
744 (setq i (1+ i)
745 j (1+ j)
746 x (1+ x)))
748 ;; Highlight the fringes and margins.
749 (if (nth 2 (window-fringes))
750 ;; fringes outside margins.
751 (setq l1 lf
752 l2 lm
753 r2 rm
754 r1 rf
755 h1 ruler-mode-fringe-help-echo
756 h2 ruler-mode-margin-help-echo
757 f1 'ruler-mode-fringes-face
758 f2 'ruler-mode-margins-face)
759 ;; fringes inside margins.
760 (setq l1 lm
761 l2 lf
762 r2 rf
763 r1 rm
764 h1 ruler-mode-margin-help-echo
765 h2 ruler-mode-fringe-help-echo
766 f1 'ruler-mode-margins-face
767 f2 'ruler-mode-fringes-face))
768 (setq i lsb j (+ i l1))
769 (put-text-property i j 'face f1 ruler)
770 (put-text-property i j 'help-echo (format h1 "Left" l1) ruler)
771 (setq i j j (+ i l2))
772 (put-text-property i j 'face f2 ruler)
773 (put-text-property i j 'help-echo (format h2 "Left" l2) ruler)
774 (setq i (+ o w) j (+ i r2))
775 (put-text-property i j 'face f2 ruler)
776 (put-text-property i j 'help-echo (format h2 "Right" r2) ruler)
777 (setq i j j (+ i r1))
778 (put-text-property i j 'face f1 ruler)
779 (put-text-property i j 'help-echo (format h1 "Right" r1) ruler)
781 ;; Show inactive areas.
782 (put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler)
783 (put-text-property j fullw 'face 'ruler-mode-pad-face ruler)
785 ;; Return the ruler propertized string.
786 ruler)))
788 (provide 'ruler-mode)
790 ;; Local Variables:
791 ;; coding: iso-latin-1
792 ;; End:
794 ;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
795 ;;; ruler-mode.el ends here