Commit | Line | Data |
---|---|---|
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 |
122 | Also 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 | |
124 | or 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. | |
307 | N 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 |
315 | START-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 |
337 | START-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. |
360 | That is `fill-column', `comment-column', `goal-column', or nil when | |
361 | nothing is dragged.") | |
362 | ||
363 | (defun ruler-mode-mouse-grab-any-column (start-event) | |
3bb804d0 JB |
364 | "Drag a column symbol on the ruler. |
365 | Start dragging on mouse down event START-EVENT, and update the column | |
366 | symbol value with the current value of the ruler graduation while | |
367 | dragging. 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 |
434 | WINDOW is the window where occurred the last down-mouse event. |
435 | Return the symbol `drag' if the mouse has been dragged, or `click' if | |
436 | the 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. |
451 | Called 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. | |
464 | START-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. | |
485 | START-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. | |
544 | This 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. | |
549 | Call `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. | |
554 | Use 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 | 559 | Unless Ruler mode is already enabled, save the old header line |
dc9a226c | 560 | format 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). |
571 | With a prefix argument ARG, enable Ruler mode if ARG is positive, | |
572 | and disable it otherwise. If called from Lisp, enable the mode | |
573 | if 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 | "\ | |
600 | S-mouse-1/3: set L/R margin, \ | |
60ab677b | 601 | mouse-2: set goal column, \ |
4f4ff50a | 602 | C-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 | "\ | |
608 | S-mouse-1/3: set L/R margin, \ | |
609 | C-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 | "\ |
615 | C-mouse1/3: set/unset tab, \ | |
616 | C-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 | "\ | |
630 | drag-mouse-2: set goal column, \ | |
631 | mouse-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. | |
644 | Optional 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 |