1;;; ruler-mode.el --- display a ruler in the header line
2
3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006,
4;;   2007 Free Software Foundation, Inc.
5
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
11
12;; This file is part of GNU Emacs.
13
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 2, or (at
17;; your option) any later version.
18
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.
23
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.
28
29;;; Commentary:
30
31;; This library provides a minor mode to display a ruler in the header
32;; line.  It works only on Emacs 21.
33;;
34;; You can use the mouse to change the `fill-column' `comment-column',
35;; `goal-column', `window-margins' and `tab-stop-list' settings:
36;;
37;; [header-line (shift down-mouse-1)] set left margin end to the ruler
38;; graduation where the mouse pointer is on.
39;;
40;; [header-line (shift down-mouse-3)] set right margin beginning to
41;; the ruler graduation where the mouse pointer is on.
42;;
43;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
44;; or `goal-column' to a ruler graduation.
45;;
46;; [header-line (control down-mouse-1)] add a tab stop to the ruler
47;; graduation where the mouse pointer is on.
48;;
49;; [header-line (control down-mouse-3)] remove the tab stop at the
50;; ruler graduation where the mouse pointer is on.
51;;
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.
56;;
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.
64;;
65;; It is also possible to customize the following characters:
66;;
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).
71;;
72;; The following faces are customizable:
73;;
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.
91;;
92;; `ruler-mode-default' inherits from the built-in `default' face.
93;; All `ruler-mode' faces inherit from `ruler-mode-default'.
94;;
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.
98;;
99;; You can override the ruler format by defining an appropriate
100;; function as the buffer-local value of `ruler-mode-ruler-function'.
101
102;; Installation
103;;
104;; To automatically display the ruler in specific major modes use:
105;;
106;;    (add-hook '<major-mode>-hook 'ruler-mode)
107;;
108
109;;; History:
110;;
111
112;;; Code:
113(eval-when-compile
114  (require 'wid-edit))
115(require 'scroll-bar)
116(require 'fringe)
117
118(defgroup ruler-mode nil
119  "Display a ruler in the header line."
120  :version "22.1"
121  :group 'convenience)
122
123(defcustom ruler-mode-show-tab-stops nil
124  "*If non-nil the ruler shows tab stop positions.
125Also 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
127or 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)
131
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      (if (char-valid-p value)
139          nil
140        (widget-put widget :error
141                    (format "Invalid character value: %S" value))
142        widget))))
143
144(defcustom ruler-mode-fill-column-char (if (char-displayable-p ?�)
145                                           ?\�
146                                         ?\|)
147  "*Character used at the `fill-column' location."
148  :group 'ruler-mode
149  :type '(choice
150          (character :tag "Character")
151          (integer :tag "Integer char value"
152                   :validate ruler-mode-character-validate)))
153
154(defcustom ruler-mode-comment-column-char ?\#
155  "*Character used at the `comment-column' location."
156  :group 'ruler-mode
157  :type '(choice
158          (character :tag "Character")
159          (integer :tag "Integer char value"
160                   :validate ruler-mode-character-validate)))
161
162(defcustom ruler-mode-goal-column-char ?G
163  "*Character used at the `goal-column' location."
164  :group 'ruler-mode
165  :type '(choice
166          (character :tag "Character")
167          (integer :tag "Integer char value"
168                   :validate ruler-mode-character-validate)))
169
170(defcustom ruler-mode-current-column-char (if (char-displayable-p ?�)
171                                              ?\�
172                                            ?\@)
173  "*Character used at the `current-column' location."
174  :group 'ruler-mode
175  :type '(choice
176          (character :tag "Character")
177          (integer :tag "Integer char value"
178                   :validate ruler-mode-character-validate)))
179
180(defcustom ruler-mode-tab-stop-char ?\T
181  "*Character used at `tab-stop-list' locations."
182  :group 'ruler-mode
183  :type '(choice
184          (character :tag "Character")
185          (integer :tag "Integer char value"
186                   :validate ruler-mode-character-validate)))
187
188(defcustom ruler-mode-basic-graduation-char ?\.
189  "*Character used for basic graduations."
190  :group 'ruler-mode
191  :type '(choice
192          (character :tag "Character")
193          (integer :tag "Integer char value"
194                   :validate ruler-mode-character-validate)))
195
196(defcustom ruler-mode-inter-graduation-char ?\!
197  "*Character used for intermediate graduations."
198  :group 'ruler-mode
199  :type '(choice
200          (character :tag "Character")
201          (integer :tag "Integer char value"
202                   :validate ruler-mode-character-validate)))
203
204(defcustom ruler-mode-set-goal-column-ding-flag t
205  "*Non-nil means do `ding' when `goal-column' is set."
206  :group 'ruler-mode
207  :type 'boolean)
208
209(defface ruler-mode-default
210  '((((type tty))
211     (:inherit default
212               :background "grey64"
213               :foreground "grey50"
214               ))
215    (t
216     (:inherit default
217               :background "grey76"
218               :foreground "grey64"
219               :box (:color "grey76"
220                            :line-width 1
221                            :style released-button)
222               )))
223  "Default face used by the ruler."
224  :group 'ruler-mode)
225
226(defface ruler-mode-pad
227  '((((type tty))
228     (:inherit ruler-mode-default
229               :background "grey50"
230               ))
231    (t
232     (:inherit ruler-mode-default
233               :background "grey64"
234               )))
235  "Face used to pad inactive ruler areas."
236  :group 'ruler-mode)
237
238(defface ruler-mode-margins
239  '((t
240     (:inherit ruler-mode-default
241               :foreground "white"
242               )))
243  "Face used to highlight margin areas."
244  :group 'ruler-mode)
245
246(defface ruler-mode-fringes
247  '((t
248     (:inherit ruler-mode-default
249               :foreground "green"
250               )))
251  "Face used to highlight fringes areas."
252  :group 'ruler-mode)
253
254(defface ruler-mode-column-number
255  '((t
256     (:inherit ruler-mode-default
257               :foreground "black"
258               )))
259  "Face used to highlight number graduations."
260  :group 'ruler-mode)
261
262(defface ruler-mode-fill-column
263  '((t
264     (:inherit ruler-mode-default
265               :foreground "red"
266               )))
267  "Face used to highlight the fill column character."
268  :group 'ruler-mode)
269
270(defface ruler-mode-comment-column
271  '((t
272     (:inherit ruler-mode-default
273               :foreground "red"
274               )))
275  "Face used to highlight the comment column character."
276  :group 'ruler-mode)
277
278(defface ruler-mode-goal-column
279  '((t
280     (:inherit ruler-mode-default
281               :foreground "red"
282               )))
283  "Face used to highlight the goal column character."
284  :group 'ruler-mode)
285
286(defface ruler-mode-tab-stop
287  '((t
288     (:inherit ruler-mode-default
289               :foreground "steelblue"
290               )))
291  "Face used to highlight tab stop characters."
292  :group 'ruler-mode)
293
294(defface ruler-mode-current-column
295  '((t
296     (:inherit ruler-mode-default
297               :weight bold
298               :foreground "yellow"
299               )))
300  "Face used to highlight the `current-column' character."
301  :group 'ruler-mode)
302
303
304(defsubst ruler-mode-full-window-width ()
305  "Return the full width of the selected window."
306  (let ((edges (window-edges)))
307    (- (nth 2 edges) (nth 0 edges))))
308
309(defsubst ruler-mode-window-col (n)
310  "Return a column number relative to the selected window.
311N is a column number relative to selected frame."
312  (- n
313     (car (window-edges))
314     (or (car (window-margins)) 0)
315     (fringe-columns 'left)
316     (scroll-bar-columns 'left)))
317
318(defun ruler-mode-mouse-set-left-margin (start-event)
319  "Set left margin end to the graduation where the mouse pointer is on.
320START-EVENT is the mouse click event."
321  (interactive "e")
322  (let* ((start (event-start start-event))
323         (end   (event-end   start-event))
324         col w lm rm)
325    (when (eq start end) ;; mouse click
326      (save-selected-window
327        (select-window (posn-window start))
328        (setq col (- (car (posn-col-row start)) (car (window-edges))
329                     (scroll-bar-columns 'left))
330              w   (- (ruler-mode-full-window-width)
331                     (scroll-bar-columns 'left)
332                     (scroll-bar-columns 'right)))
333        (when (and (>= col 0) (< col w))
334          (setq lm (window-margins)
335                rm (or (cdr lm) 0)
336                lm (or (car lm) 0))
337          (message "Left margin set to %d (was %d)" col lm)
338          (set-window-margins nil col rm))))))
339
340(defun ruler-mode-mouse-set-right-margin (start-event)
341  "Set right margin beginning to the graduation where the mouse pointer is on.
342START-EVENT is the mouse click event."
343  (interactive "e")
344  (let* ((start (event-start start-event))
345         (end   (event-end   start-event))
346         col w lm rm)
347    (when (eq start end) ;; mouse click
348      (save-selected-window
349        (select-window (posn-window start))
350        (setq col (- (car (posn-col-row start)) (car (window-edges))
351                     (scroll-bar-columns 'left))
352              w   (- (ruler-mode-full-window-width)
353                     (scroll-bar-columns 'left)
354                     (scroll-bar-columns 'right)))
355        (when (and (>= col 0) (< col w))
356          (setq lm  (window-margins)
357                rm  (or (cdr lm) 0)
358                lm  (or (car lm) 0)
359                col (- w col 1))
360          (message "Right margin set to %d (was %d)" col rm)
361          (set-window-margins nil lm col))))))
362
363(defvar ruler-mode-dragged-symbol nil
364  "Column symbol dragged in the ruler.
365That is `fill-column', `comment-column', `goal-column', or nil when
366nothing is dragged.")
367
368(defun ruler-mode-mouse-grab-any-column (start-event)
369  "Drag a column symbol on the ruler.
370Start dragging on mouse down event START-EVENT, and update the column
371symbol value with the current value of the ruler graduation while
372dragging.  See also the variable `ruler-mode-dragged-symbol'."
373  (interactive "e")
374  (setq ruler-mode-dragged-symbol nil)
375  (let* ((start (event-start start-event))
376         col newc oldc)
377    (save-selected-window
378      (select-window (posn-window start))
379      (setq col  (ruler-mode-window-col (car (posn-col-row start)))
380            newc (+ col (window-hscroll)))
381      (and
382       (>= col 0) (< col (window-width))
383       (cond
384
385        ;; Handle the fill column.
386        ((eq newc fill-column)
387         (setq oldc fill-column
388               ruler-mode-dragged-symbol 'fill-column)
389         t) ;; Start dragging
390
391        ;; Handle the comment column.
392        ((eq newc comment-column)
393         (setq oldc comment-column
394               ruler-mode-dragged-symbol 'comment-column)
395         t) ;; Start dragging
396
397        ;; Handle the goal column.
398        ;; A. On mouse down on the goal column character on the ruler,
399        ;;    update the `goal-column' value while dragging.
400        ;; B. If `goal-column' is nil, set the goal column where the
401        ;;    mouse is clicked.
402        ;; C. On mouse click on the goal column character on the
403        ;;    ruler, unset the goal column.
404        ((eq newc goal-column)          ; A. Drag the goal column.
405         (setq oldc goal-column
406               ruler-mode-dragged-symbol 'goal-column)
407         t) ;; Start dragging
408
409        ((null goal-column)             ; B. Set the goal column.
410         (setq oldc goal-column
411               goal-column newc)
412         ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'.  This
413         ;; `ding' flushes the next messages about setting goal
414         ;; column.  So here I force fetch the event(mouse-2) and
415         ;; throw away.
416         (read-event)
417         ;; Ding BEFORE `message' is OK.
418         (when ruler-mode-set-goal-column-ding-flag
419           (ding))
420         (message "Goal column set to %d (click on %s again to unset it)"
421                  newc
422                  (propertize (char-to-string ruler-mode-goal-column-char)
423                              'face 'ruler-mode-goal-column))
424         nil) ;; Don't start dragging.
425        )
426       (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
427                       (posn-window start)))
428           (when (eq 'goal-column ruler-mode-dragged-symbol)
429             ;; C. Unset the goal column.
430             (set-goal-column t))
431         ;; At end of dragging, report the updated column symbol.
432         (message "%s is set to %d (was %d)"
433                  ruler-mode-dragged-symbol
434                  (symbol-value ruler-mode-dragged-symbol)
435                  oldc))))))
436
437(defun ruler-mode-mouse-drag-any-column-iteration (window)
438  "Update the ruler while dragging the mouse.
439WINDOW is the window where occurred the last down-mouse event.
440Return the symbol `drag' if the mouse has been dragged, or `click' if
441the mouse has been clicked."
442  (let ((drags 0)
443        event)
444    (track-mouse
445      (while (mouse-movement-p (setq event (read-event)))
446        (setq drags (1+ drags))
447        (when (eq window (posn-window (event-end event)))
448          (ruler-mode-mouse-drag-any-column event)
449          (force-mode-line-update))))
450    (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
451        'click
452      'drag)))
453
454(defun ruler-mode-mouse-drag-any-column (start-event)
455  "Update the value of the symbol dragged on the ruler.
456Called on each mouse motion event START-EVENT."
457  (let* ((start (event-start start-event))
458         (end   (event-end   start-event))
459         col newc)
460    (save-selected-window
461      (select-window (posn-window start))
462      (setq col  (ruler-mode-window-col (car (posn-col-row end)))
463            newc (+ col (window-hscroll)))
464      (when (and (>= col 0) (< col (window-width)))
465        (set ruler-mode-dragged-symbol newc)))))
466
467(defun ruler-mode-mouse-add-tab-stop (start-event)
468  "Add a tab stop to the graduation where the mouse pointer is on.
469START-EVENT is the mouse click event."
470  (interactive "e")
471  (when ruler-mode-show-tab-stops
472    (let* ((start (event-start start-event))
473           (end   (event-end   start-event))
474           col ts)
475      (when (eq start end) ;; mouse click
476        (save-selected-window
477          (select-window (posn-window start))
478          (setq col (ruler-mode-window-col (car (posn-col-row start)))
479                ts  (+ col (window-hscroll)))
480          (and (>= col 0) (< col (window-width))
481               (not (member ts tab-stop-list))
482               (progn
483                 (message "Tab stop set to %d" ts)
484                 (setq tab-stop-list (sort (cons ts tab-stop-list)
485                                           #'<)))))))))
486
487(defun ruler-mode-mouse-del-tab-stop (start-event)
488  "Delete tab stop at the graduation where the mouse pointer is on.
489START-EVENT is the mouse click event."
490  (interactive "e")
491  (when ruler-mode-show-tab-stops
492    (let* ((start (event-start start-event))
493           (end   (event-end   start-event))
494           col ts)
495      (when (eq start end) ;; mouse click
496        (save-selected-window
497          (select-window (posn-window start))
498          (setq col (ruler-mode-window-col (car (posn-col-row start)))
499                ts  (+ col (window-hscroll)))
500          (and (>= col 0) (< col (window-width))
501               (member ts tab-stop-list)
502               (progn
503                 (message "Tab stop at %d deleted" ts)
504                 (setq tab-stop-list (delete ts tab-stop-list)))))))))
505
506(defun ruler-mode-toggle-show-tab-stops ()
507  "Toggle showing of tab stops on the ruler."
508  (interactive)
509  (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
510  (force-mode-line-update))
511
512(defvar ruler-mode-map
513  (let ((km (make-sparse-keymap)))
514    (define-key km [header-line down-mouse-1]
515      #'ignore)
516    (define-key km [header-line down-mouse-3]
517      #'ignore)
518    (define-key km [header-line down-mouse-2]
519      #'ruler-mode-mouse-grab-any-column)
520    (define-key km [header-line (shift down-mouse-1)]
521      #'ruler-mode-mouse-set-left-margin)
522    (define-key km [header-line (shift down-mouse-3)]
523      #'ruler-mode-mouse-set-right-margin)
524    (define-key km [header-line (control down-mouse-1)]
525      #'ruler-mode-mouse-add-tab-stop)
526    (define-key km [header-line (control down-mouse-3)]
527      #'ruler-mode-mouse-del-tab-stop)
528    (define-key km [header-line (control down-mouse-2)]
529      #'ruler-mode-toggle-show-tab-stops)
530    (define-key km [header-line (shift mouse-1)]
531      'ignore)
532    (define-key km [header-line (shift mouse-3)]
533      'ignore)
534    (define-key km [header-line (control mouse-1)]
535      'ignore)
536    (define-key km [header-line (control mouse-3)]
537      'ignore)
538    (define-key km [header-line (control mouse-2)]
539      'ignore)
540    km)
541  "Keymap for ruler minor mode.")
542
543(defvar ruler-mode-header-line-format-old nil
544  "Hold previous value of `header-line-format'.")
545
546(defvar ruler-mode-ruler-function 'ruler-mode-ruler
547  "Function to call to return ruler header line format.
548This variable is expected to be made buffer-local by modes.")
549
550(defconst ruler-mode-header-line-format
551  '(:eval (funcall ruler-mode-ruler-function))
552  "`header-line-format' used in ruler mode.
553Call `ruler-mode-ruler-function' to compute the ruler value.")
554
555;;;###autoload
556(define-minor-mode ruler-mode
557  "Display a ruler in the header line if ARG > 0."
558  nil nil
559  ruler-mode-map
560  :group 'ruler-mode
561  (if ruler-mode
562      (progn
563        ;; When `ruler-mode' is on save previous header line format
564        ;; and install the ruler header line format.
565        (when (local-variable-p 'header-line-format)
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)))
578
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)))
583
584(defconst ruler-mode-ruler-help-echo
585  "\
586S-mouse-1/3: set L/R margin, \
587mouse-2: set goal column, \
588C-mouse-2: show tabs"
589  "Help string shown when mouse is over the ruler.
590`ruler-mode-show-tab-stops' is nil.")
591
592(defconst ruler-mode-ruler-help-echo-when-goal-column
593  "\
594S-mouse-1/3: set L/R margin, \
595C-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.")
598
599(defconst ruler-mode-ruler-help-echo-when-tab-stops
600  "\
601C-mouse1/3: set/unset tab, \
602C-mouse-2: hide tabs"
603  "Help string shown when mouse is over the ruler.
604`ruler-mode-show-tab-stops' is non-nil.")
605
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.")
609
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.")
613
614(defconst ruler-mode-goal-column-help-echo
615  "\
616drag-mouse-2: set goal column, \
617mouse-2: unset goal column"
618  "Help string shown when mouse is on the goal column character.")
619
620(defconst ruler-mode-margin-help-echo
621  "%s margin %S"
622  "Help string shown when mouse is over a margin area.")
623
624(defconst ruler-mode-fringe-help-echo
625  "%s fringe %S"
626  "Help string shown when mouse is over a fringe area.")
627
628(defsubst ruler-mode-space (width &rest props)
629  "Return a single space string of WIDTH times the normal character width.
630Optional argument PROPS specifies other text properties to apply."
631  (apply 'propertize " " 'display (list 'space :width width) props))
632
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           (make-string w ruler-mode-basic-graduation-char)
670           'face 'ruler-mode-default
671           'local-map ruler-mode-map
672           'help-echo (cond
673                       (ruler-mode-show-tab-stops
674                        ruler-mode-ruler-help-echo-when-tab-stops)
675                       (goal-column
676                        ruler-mode-ruler-help-echo-when-goal-column)
677                       (ruler-mode-ruler-help-echo))))
678         k c)
679    ;; Setup the active area.
680    (while (< i w)
681      ;; Graduations.
682      (cond
683       ;; Show a number graduation.
684       ((= (mod j 10) 0)
685        (setq c (number-to-string (/ j 10))
686              m (length c)
687              k i)
688        (put-text-property
689         i (1+ i) 'face 'ruler-mode-column-number
690         ruler)
691        (while (and (> m 0) (>= k 0))
692          (aset ruler k (aref c (setq m (1- m))))
693          (setq k (1- k))))
694       ;; Show an intermediate graduation.
695       ((= (mod j 5) 0)
696        (aset ruler i ruler-mode-inter-graduation-char)))
697      ;; Special columns.
698      (cond
699       ;; Show the `current-column' marker.
700       ((= j (current-column))
701        (aset ruler i ruler-mode-current-column-char)
702        (put-text-property
703         i (1+ i) 'face 'ruler-mode-current-column
704         ruler))
705       ;; Show the `goal-column' marker.
706       ((and goal-column (= j goal-column))
707        (aset ruler i ruler-mode-goal-column-char)
708        (put-text-property
709         i (1+ i) 'face 'ruler-mode-goal-column
710         ruler)
711	(put-text-property
712         i (1+ i) 'mouse-face 'mode-line-highlight
713         ruler)
714        (put-text-property
715         i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
716         ruler))
717       ;; Show the `comment-column' marker.
718       ((= j comment-column)
719        (aset ruler i ruler-mode-comment-column-char)
720        (put-text-property
721         i (1+ i) 'face 'ruler-mode-comment-column
722         ruler)
723	(put-text-property
724         i (1+ i) 'mouse-face 'mode-line-highlight
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
734         ruler)
735	(put-text-property
736         i (1+ i) 'mouse-face 'mode-line-highlight
737         ruler)
738        (put-text-property
739         i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
740         ruler))
741       ;; Show the `tab-stop-list' markers.
742       ((and ruler-mode-show-tab-stops (member j tab-stop-list))
743        (aset ruler i ruler-mode-tab-stop-char)
744        (put-text-property
745         i (1+ i) 'face 'ruler-mode-tab-stop
746         ruler)))
747      (setq i (1+ i)
748            j (1+ j)))
749    ;; Return the ruler propertized string.  Using list here,
750    ;; instead of concat visually separate the different areas.
751    (if (nth 2 (window-fringes))
752        ;; fringes outside margins.
753        (list "" (and (eq 'left sbvt) sb) lf lm
754              ruler rm rf (and (eq 'right sbvt) sb))
755      ;; fringes inside margins.
756      (list "" (and (eq 'left sbvt) sb) lm lf
757            ruler rf rm (and (eq 'right sbvt) sb)))))
758
759(provide 'ruler-mode)
760
761;; Local Variables:
762;; coding: iso-latin-1
763;; End:
764
765;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
766;;; ruler-mode.el ends here
767