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