5 |
;; Author: David Ponce <david@dponce.com> |
;; Author: David Ponce <david@dponce.com> |
6 |
;; Maintainer: David Ponce <david@dponce.com> |
;; Maintainer: David Ponce <david@dponce.com> |
7 |
;; Created: 24 Mar 2001 |
;; Created: 24 Mar 2001 |
8 |
;; Version: 1.5 |
;; Version: 1.6 |
9 |
;; Keywords: convenience |
;; Keywords: convenience |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
33 |
;; You can use the mouse to change the `fill-column' `comment-column', |
;; You can use the mouse to change the `fill-column' `comment-column', |
34 |
;; `goal-column', `window-margins' and `tab-stop-list' settings: |
;; `goal-column', `window-margins' and `tab-stop-list' settings: |
35 |
;; |
;; |
36 |
;; [header-line (shift down-mouse-1)] set left margin to the ruler |
;; [header-line (shift down-mouse-1)] set left margin end to the ruler |
37 |
;; graduation where the mouse pointer is on. |
;; graduation where the mouse pointer is on. |
38 |
;; |
;; |
39 |
;; [header-line (shift down-mouse-3)] set right margin to the ruler |
;; [header-line (shift down-mouse-3)] set right margin beginning to |
40 |
;; graduation where the mouse pointer is on. |
;; the ruler graduation where the mouse pointer is on. |
41 |
;; |
;; |
42 |
;; [header-line down-mouse-2] set `fill-column', `comment-column' or |
;; [header-line down-mouse-2] Drag the `fill-column', `comment-column' |
43 |
;; `goal-column' to the ruler graduation with the mouse dragging. |
;; or `goal-column' to a ruler graduation. |
44 |
;; |
;; |
45 |
;; [header-line (control down-mouse-1)] add a tab stop to the ruler |
;; [header-line (control down-mouse-1)] add a tab stop to the ruler |
46 |
;; graduation where the mouse pointer is on. |
;; graduation where the mouse pointer is on. |
57 |
;; the `current-column' location, `ruler-mode-fill-column-char' shows |
;; the `current-column' location, `ruler-mode-fill-column-char' shows |
58 |
;; the `fill-column' location, `ruler-mode-comment-column-char' shows |
;; the `fill-column' location, `ruler-mode-comment-column-char' shows |
59 |
;; the `comment-column' location, `ruler-mode-goal-column-char' shows |
;; the `comment-column' location, `ruler-mode-goal-column-char' shows |
60 |
;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab |
;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop |
61 |
;; stop locations. `window-margins' areas are shown with a different |
;; locations. Graduations in `window-margins' and `window-fringes' |
62 |
;; background color. |
;; areas are shown with a different foreground color. |
63 |
;; |
;; |
64 |
;; It is also possible to customize the following characters: |
;; It is also possible to customize the following characters: |
65 |
;; |
;; |
|
;; - `ruler-mode-margins-char' character used to pad margin areas |
|
|
;; (space by default). |
|
66 |
;; - `ruler-mode-basic-graduation-char' character used for basic |
;; - `ruler-mode-basic-graduation-char' character used for basic |
67 |
;; graduations ('.' by default). |
;; graduations ('.' by default). |
68 |
;; - `ruler-mode-inter-graduation-char' character used for |
;; - `ruler-mode-inter-graduation-char' character used for |
81 |
;; `current-column' character. |
;; `current-column' character. |
82 |
;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop |
;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop |
83 |
;; characters. |
;; characters. |
84 |
;; - `ruler-mode-margins-face' the face used to highlight the |
;; - `ruler-mode-margins-face' the face used to highlight graduations |
85 |
;; `window-margins' areas. |
;; in the `window-margins' areas. |
86 |
|
;; - `ruler-mode-fringes-face' the face used to highlight graduations |
87 |
|
;; in the `window-fringes' areas. |
88 |
;; - `ruler-mode-column-number-face' the face used to highlight the |
;; - `ruler-mode-column-number-face' the face used to highlight the |
89 |
;; number graduations. |
;; numbered graduations. |
90 |
;; |
;; |
91 |
;; `ruler-mode-default-face' inherits from the built-in `default' face. |
;; `ruler-mode-default-face' inherits from the built-in `default' face. |
92 |
;; All `ruler-mode' faces inerit from `ruler-mode-default-face'. |
;; All `ruler-mode' faces inherit from `ruler-mode-default-face'. |
93 |
;; |
;; |
94 |
;; WARNING: To keep ruler graduations aligned on text columns it is |
;; WARNING: To keep ruler graduations aligned on text columns it is |
95 |
;; important to use the same font family and size for ruler and text |
;; important to use the same font family and size for ruler and text |
135 |
(format "Invalid character value: %S" value)) |
(format "Invalid character value: %S" value)) |
136 |
widget)))) |
widget)))) |
137 |
|
|
138 |
(defcustom ruler-mode-fill-column-char (if window-system |
(defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶) |
139 |
?\¶ |
?\¶ |
140 |
?\|) |
?\|) |
141 |
"*Character used at the `fill-column' location." |
"*Character used at the `fill-column' location." |
161 |
(integer :tag "Integer char value" |
(integer :tag "Integer char value" |
162 |
:validate ruler-mode-character-validate))) |
:validate ruler-mode-character-validate))) |
163 |
|
|
164 |
(defcustom ruler-mode-current-column-char (if window-system |
(defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦) |
165 |
?\¦ |
?\¦ |
166 |
?\@) |
?\@) |
167 |
"*Character used at the `current-column' location." |
"*Character used at the `current-column' location." |
179 |
(integer :tag "Integer char value" |
(integer :tag "Integer char value" |
180 |
:validate ruler-mode-character-validate))) |
:validate ruler-mode-character-validate))) |
181 |
|
|
|
(defcustom ruler-mode-margins-char ?\s |
|
|
"*Character used in margin areas." |
|
|
:group 'ruler-mode |
|
|
:type '(choice |
|
|
(character :tag "Character") |
|
|
(integer :tag "Integer char value" |
|
|
:validate ruler-mode-character-validate))) |
|
|
|
|
182 |
(defcustom ruler-mode-basic-graduation-char ?\. |
(defcustom ruler-mode-basic-graduation-char ?\. |
183 |
"*Character used for basic graduations." |
"*Character used for basic graduations." |
184 |
:group 'ruler-mode |
:group 'ruler-mode |
217 |
"Default face used by the ruler." |
"Default face used by the ruler." |
218 |
:group 'ruler-mode) |
:group 'ruler-mode) |
219 |
|
|
220 |
|
(defface ruler-mode-pad-face |
221 |
|
'((((type tty)) |
222 |
|
(:inherit ruler-mode-default-face |
223 |
|
:background "grey50" |
224 |
|
)) |
225 |
|
(t |
226 |
|
(:inherit ruler-mode-default-face |
227 |
|
:background "grey64" |
228 |
|
))) |
229 |
|
"Face used to pad inactive ruler areas." |
230 |
|
:group 'ruler-mode) |
231 |
|
|
232 |
|
(defface ruler-mode-margins-face |
233 |
|
'((t |
234 |
|
(:inherit ruler-mode-default-face |
235 |
|
:foreground "white" |
236 |
|
))) |
237 |
|
"Face used to highlight margin areas." |
238 |
|
:group 'ruler-mode) |
239 |
|
|
240 |
|
(defface ruler-mode-fringes-face |
241 |
|
'((t |
242 |
|
(:inherit ruler-mode-default-face |
243 |
|
:foreground "green" |
244 |
|
))) |
245 |
|
"Face used to highlight fringes areas." |
246 |
|
:group 'ruler-mode) |
247 |
|
|
248 |
(defface ruler-mode-column-number-face |
(defface ruler-mode-column-number-face |
249 |
'((t |
'((t |
250 |
(:inherit ruler-mode-default-face |
(:inherit ruler-mode-default-face |
285 |
"Face used to highlight tab stop characters." |
"Face used to highlight tab stop characters." |
286 |
:group 'ruler-mode) |
:group 'ruler-mode) |
287 |
|
|
|
(defface ruler-mode-margins-face |
|
|
'((((type tty)) |
|
|
(:inherit ruler-mode-default-face |
|
|
:background "grey50" |
|
|
)) |
|
|
(t |
|
|
(:inherit ruler-mode-default-face |
|
|
:background "grey64" |
|
|
))) |
|
|
"Face used to highlight the `window-margins' areas." |
|
|
:group 'ruler-mode) |
|
|
|
|
288 |
(defface ruler-mode-current-column-face |
(defface ruler-mode-current-column-face |
289 |
'((t |
'((t |
290 |
(:inherit ruler-mode-default-face |
(:inherit ruler-mode-default-face |
294 |
"Face used to highlight the `current-column' character." |
"Face used to highlight the `current-column' character." |
295 |
:group 'ruler-mode) |
:group 'ruler-mode) |
296 |
|
|
297 |
|
(defmacro ruler-mode-left-fringe-cols () |
298 |
|
"Return the width, measured in columns, of the left fringe area." |
299 |
|
'(ceiling (or (car (window-fringes)) 0) |
300 |
|
(frame-char-width))) |
301 |
|
|
302 |
|
(defmacro ruler-mode-right-fringe-cols () |
303 |
|
"Return the width, measured in columns, of the right fringe area." |
304 |
|
'(ceiling (or (nth 1 (window-fringes)) 0) |
305 |
|
(frame-char-width))) |
306 |
|
|
307 |
|
(defun ruler-mode-left-scroll-bar-cols () |
308 |
|
"Return the width, measured in columns, of the right vertical scrollbar." |
309 |
|
(let* ((wsb (window-scroll-bars)) |
310 |
|
(vtype (nth 2 wsb)) |
311 |
|
(cols (nth 1 wsb))) |
312 |
|
(if (or (eq vtype 'left) |
313 |
|
(and (eq vtype t) |
314 |
|
(eq (frame-parameter nil 'vertical-scroll-bars) 'left))) |
315 |
|
(or cols |
316 |
|
(ceiling |
317 |
|
;; nil means it's a non-toolkit scroll bar, |
318 |
|
;; and its width in columns is 14 pixels rounded up. |
319 |
|
(or (frame-parameter nil 'scroll-bar-width) 14) |
320 |
|
;; Always round up to multiple of columns. |
321 |
|
(frame-char-width))) |
322 |
|
0))) |
323 |
|
|
324 |
|
(defun ruler-mode-right-scroll-bar-cols () |
325 |
|
"Return the width, measured in columns, of the right vertical scrollbar." |
326 |
|
(let* ((wsb (window-scroll-bars)) |
327 |
|
(vtype (nth 2 wsb)) |
328 |
|
(cols (nth 1 wsb))) |
329 |
|
(if (or (eq vtype 'right) |
330 |
|
(and (eq vtype t) |
331 |
|
(eq (frame-parameter nil 'vertical-scroll-bars) 'right))) |
332 |
|
(or cols |
333 |
|
(ceiling |
334 |
|
;; nil means it's a non-toolkit scroll bar, |
335 |
|
;; and its width in columns is 14 pixels rounded up. |
336 |
|
(or (frame-parameter nil 'scroll-bar-width) 14) |
337 |
|
;; Always round up to multiple of columns. |
338 |
|
(frame-char-width))) |
339 |
|
0))) |
340 |
|
|
341 |
|
(defsubst ruler-mode-full-window-width () |
342 |
|
"Return the full width of the selected window." |
343 |
|
(let ((edges (window-edges))) |
344 |
|
(- (nth 2 edges) (nth 0 edges)))) |
345 |
|
|
346 |
|
(defsubst ruler-mode-window-col (n) |
347 |
|
"Return a column number relative to the selected window. |
348 |
|
N is a column number relative to selected frame." |
349 |
|
(- n |
350 |
|
(car (window-edges)) |
351 |
|
(or (car (window-margins)) 0) |
352 |
|
(ruler-mode-left-fringe-cols) |
353 |
|
(ruler-mode-left-scroll-bar-cols))) |
354 |
|
|
355 |
(defun ruler-mode-mouse-set-left-margin (start-event) |
(defun ruler-mode-mouse-set-left-margin (start-event) |
356 |
"Set left margin to the graduation where the mouse pointer is on. |
"Set left margin end to the graduation where the mouse pointer is on. |
357 |
START-EVENT is the mouse click event." |
START-EVENT is the mouse click event." |
358 |
(interactive "e") |
(interactive "e") |
359 |
(let* ((start (event-start start-event)) |
(let* ((start (event-start start-event)) |
360 |
(end (event-end start-event)) |
(end (event-end start-event)) |
361 |
w col m lm0 lm rm) |
col w lm rm) |
362 |
(if (eq start end) ;; mouse click |
(when (eq start end) ;; mouse click |
363 |
(save-selected-window |
(save-selected-window |
364 |
(select-window (posn-window start)) |
(select-window (posn-window start)) |
365 |
(setq m (window-margins) |
(setq col (- (car (posn-col-row start)) (car (window-edges)) |
366 |
lm0 (or (car m) 0) |
(ruler-mode-left-scroll-bar-cols)) |
367 |
rm (or (cdr m) 0) |
w (- (ruler-mode-full-window-width) |
368 |
w (window-width) |
(ruler-mode-left-scroll-bar-cols) |
369 |
col (car (posn-col-row start)) |
(ruler-mode-right-scroll-bar-cols))) |
370 |
lm (min (- w rm) col)) |
(when (and (>= col 0) (< col w)) |
371 |
(message "Left margin set to %d (was %d)" lm lm0) |
(setq lm (window-margins) |
372 |
(set-window-margins nil lm rm))))) |
rm (or (cdr lm) 0) |
373 |
|
lm (or (car lm) 0)) |
374 |
|
(message "Left margin set to %d (was %d)" col lm) |
375 |
|
(set-window-margins nil col rm)))))) |
376 |
|
|
377 |
(defun ruler-mode-mouse-set-right-margin (start-event) |
(defun ruler-mode-mouse-set-right-margin (start-event) |
378 |
"Set right margin to the graduation where the mouse pointer is on. |
"Set right margin beginning to the graduation where the mouse pointer is on. |
379 |
START-EVENT is the mouse click event." |
START-EVENT is the mouse click event." |
380 |
(interactive "e") |
(interactive "e") |
381 |
(let* ((start (event-start start-event)) |
(let* ((start (event-start start-event)) |
382 |
(end (event-end start-event)) |
(end (event-end start-event)) |
383 |
m col w lm rm0 rm) |
col w lm rm) |
384 |
(if (eq start end) ;; mouse click |
(when (eq start end) ;; mouse click |
385 |
(save-selected-window |
(save-selected-window |
386 |
(select-window (posn-window start)) |
(select-window (posn-window start)) |
387 |
(setq m (window-margins) |
(setq col (- (car (posn-col-row start)) (car (window-edges)) |
388 |
rm0 (or (cdr m) 0) |
(ruler-mode-left-scroll-bar-cols)) |
389 |
lm (or (car m) 0) |
w (- (ruler-mode-full-window-width) |
390 |
col (car (posn-col-row start)) |
(ruler-mode-left-scroll-bar-cols) |
391 |
w (window-width) |
(ruler-mode-right-scroll-bar-cols))) |
392 |
rm (max 0 (- w col))) |
(when (and (>= col 0) (< col w)) |
393 |
(message "Right margin set to %d (was %d)" rm rm0) |
(setq lm (window-margins) |
394 |
(set-window-margins nil lm rm))))) |
rm (or (cdr lm) 0) |
395 |
|
lm (or (car lm) 0) |
396 |
|
col (- w col 1)) |
397 |
|
(message "Right margin set to %d (was %d)" col rm) |
398 |
|
(set-window-margins nil lm col)))))) |
399 |
|
|
400 |
(defvar ruler-mode-mouse-current-grab-object nil |
(defvar ruler-mode-dragged-symbol nil |
401 |
"Column symbol dragged in the ruler. |
"Column symbol dragged in the ruler. |
402 |
That is `fill-column', `comment-column', `goal-column', or nil when |
That is `fill-column', `comment-column', `goal-column', or nil when |
403 |
nothing is dragged.") |
nothing is dragged.") |
404 |
|
|
405 |
(defun ruler-mode-mouse-grab-any-column (start-event) |
(defun ruler-mode-mouse-grab-any-column (start-event) |
406 |
"Set a column symbol to the graduation with mouse dragging. |
"Drag a column symbol on the ruler. |
407 |
See also variable `ruler-mode-mouse-current-grab-object'. |
Start dragging on mouse down event START-EVENT, and update the column |
408 |
START-EVENT is the mouse down event." |
symbol value with the current value of the ruler graduation while |
409 |
|
dragging. See also the variable `ruler-mode-dragged-symbol'." |
410 |
(interactive "e") |
(interactive "e") |
411 |
(setq ruler-mode-mouse-current-grab-object nil) |
(setq ruler-mode-dragged-symbol nil) |
412 |
(let* ((start (event-start start-event)) |
(let* ((start (event-start start-event)) |
413 |
m col w lm rm hs newc oldc) |
col newc oldc) |
414 |
(save-selected-window |
(save-selected-window |
415 |
(select-window (posn-window start)) |
(select-window (posn-window start)) |
416 |
(setq m (window-margins) |
(setq col (ruler-mode-window-col (car (posn-col-row start))) |
417 |
lm (or (car m) 0) |
newc (+ col (window-hscroll))) |
418 |
rm (or (cdr m) 0) |
(and |
419 |
col (- (car (posn-col-row start)) lm) |
(>= col 0) (< col (window-width)) |
420 |
w (window-width) |
(cond |
421 |
hs (window-hscroll) |
|
422 |
newc (+ col hs)) |
;; Handle the fill column. |
423 |
;; |
((eq newc fill-column) |
424 |
;; About the ways to handle the goal column: |
(setq oldc fill-column |
425 |
;; A. update the value of the goal column if goal-column has |
ruler-mode-dragged-symbol 'fill-column) |
426 |
;; non-nil value and if the mouse is dragged |
t) ;; Start dragging |
427 |
;; B. set value to the goal column if goal-column has nil and if |
|
428 |
;; the mouse is just clicked, not dragged. |
;; Handle the comment column. |
429 |
;; C. unset value to the goal column if goal-column has non-nil |
((eq newc comment-column) |
430 |
;; and mouse is just clicked on goal-column character on the |
(setq oldc comment-column |
431 |
;; ruler, not dragged. |
ruler-mode-dragged-symbol 'comment-column) |
432 |
;; |
t) ;; Start dragging |
433 |
(and (>= col 0) (< (+ col lm rm) w) |
|
434 |
(cond |
;; Handle the goal column. |
435 |
((eq newc fill-column) |
;; A. On mouse down on the goal column character on the ruler, |
436 |
(setq oldc fill-column) |
;; update the `goal-column' value while dragging. |
437 |
(setq ruler-mode-mouse-current-grab-object 'fill-column) |
;; B. If `goal-column' is nil, set the goal column where the |
438 |
t) |
;; mouse is clicked. |
439 |
((eq newc comment-column) |
;; C. On mouse click on the goal column character on the |
440 |
(setq oldc comment-column) |
;; ruler, unset the goal column. |
441 |
(setq ruler-mode-mouse-current-grab-object 'comment-column) |
((eq newc goal-column) ; A. Drag the goal column. |
442 |
t) |
(setq oldc goal-column |
443 |
((eq newc goal-column) ; A. update goal column |
ruler-mode-dragged-symbol 'goal-column) |
444 |
(setq oldc goal-column) |
t) ;; Start dragging |
445 |
(setq ruler-mode-mouse-current-grab-object 'goal-column) |
|
446 |
t) |
((null goal-column) ; B. Set the goal column. |
447 |
((null goal-column) ; B. set goal column |
(setq oldc goal-column |
448 |
(setq oldc goal-column) |
goal-column newc) |
449 |
(setq goal-column newc) |
;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This |
450 |
;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. |
;; `ding' flushes the next messages about setting goal |
451 |
;; This `ding' flushes the next messages about setting |
;; column. So here I force fetch the event(mouse-2) and |
452 |
;; goal column. So here I force fetch the event(mouse-2) |
;; throw away. |
453 |
;; and throw away. |
(read-event) |
454 |
(read-event) |
;; Ding BEFORE `message' is OK. |
455 |
;; Ding BEFORE `message' is OK. |
(when ruler-mode-set-goal-column-ding-flag |
456 |
(if ruler-mode-set-goal-column-ding-flag |
(ding)) |
457 |
(ding)) |
(message "Goal column set to %d (click on %s again to unset it)" |
458 |
(message |
newc |
459 |
"Goal column %d (click `%s' on the ruler again to unset it)" |
(propertize (char-to-string ruler-mode-goal-column-char) |
460 |
newc |
'face 'ruler-mode-goal-column-face)) |
461 |
(propertize (char-to-string ruler-mode-goal-column-char) |
nil) ;; Don't start dragging. |
462 |
'face 'ruler-mode-goal-column-face)) |
) |
463 |
;; don't enter drag iteration |
(if (eq 'click (ruler-mode-mouse-drag-any-column-iteration |
464 |
nil)) |
(posn-window start))) |
465 |
(if (eq 'click (ruler-mode-mouse-drag-any-column-iteration |
(when (eq 'goal-column ruler-mode-dragged-symbol) |
466 |
(posn-window start))) |
;; C. Unset the goal column. |
467 |
(if (eq 'goal-column ruler-mode-mouse-current-grab-object) |
(set-goal-column t)) |
468 |
;; C. unset goal column |
;; At end of dragging, report the updated column symbol. |
469 |
(set-goal-column t)) |
(message "%s is set to %d (was %d)" |
470 |
;; *-column is updated; report it |
ruler-mode-dragged-symbol |
471 |
(message "%s is set to %d (was %d)" |
(symbol-value ruler-mode-dragged-symbol) |
472 |
ruler-mode-mouse-current-grab-object |
oldc)))))) |
|
(eval ruler-mode-mouse-current-grab-object) |
|
|
oldc)))))) |
|
473 |
|
|
474 |
(defun ruler-mode-mouse-drag-any-column-iteration (window) |
(defun ruler-mode-mouse-drag-any-column-iteration (window) |
475 |
"Update the ruler while dragging the mouse. |
"Update the ruler while dragging the mouse. |
476 |
WINDOW is the window where the last down-mouse event is occurred. |
WINDOW is the window where occurred the last down-mouse event. |
477 |
Return a symbol `drag' if the mouse is actually dragged. |
Return the symbol `drag' if the mouse has been dragged, or `click' if |
478 |
Return a symbol `click' if the mouse is just clicked." |
the mouse has been clicked." |
479 |
(let (newevent |
(let ((drags 0) |
480 |
(drag-count 0)) |
event) |
481 |
(track-mouse |
(track-mouse |
482 |
(while (progn |
(while (mouse-movement-p (setq event (read-event))) |
483 |
(setq newevent (read-event)) |
(setq drags (1+ drags)) |
484 |
(mouse-movement-p newevent)) |
(when (eq window (posn-window (event-end event))) |
485 |
(setq drag-count (1+ drag-count)) |
(ruler-mode-mouse-drag-any-column event) |
486 |
(if (eq window (posn-window (event-end newevent))) |
(force-mode-line-update)))) |
487 |
(progn |
(if (and (zerop drags) (eq 'click (car (event-modifiers event)))) |
|
(ruler-mode-mouse-drag-any-column newevent) |
|
|
(force-mode-line-update))))) |
|
|
(if (and (eq drag-count 0) |
|
|
(eq 'click (car (event-modifiers newevent)))) |
|
488 |
'click |
'click |
489 |
'drag))) |
'drag))) |
490 |
|
|
491 |
(defun ruler-mode-mouse-drag-any-column (start-event) |
(defun ruler-mode-mouse-drag-any-column (start-event) |
492 |
"Update the ruler for START-EVENT, one mouse motion event." |
"Update the value of the symbol dragged on the ruler. |
493 |
|
Called on each mouse motion event START-EVENT." |
494 |
(let* ((start (event-start start-event)) |
(let* ((start (event-start start-event)) |
495 |
(end (event-end start-event)) |
(end (event-end start-event)) |
496 |
m col w lm rm hs newc) |
col newc) |
497 |
(save-selected-window |
(save-selected-window |
498 |
(select-window (posn-window start)) |
(select-window (posn-window start)) |
499 |
(setq m (window-margins) |
(setq col (ruler-mode-window-col (car (posn-col-row end))) |
500 |
lm (or (car m) 0) |
newc (+ col (window-hscroll))) |
501 |
rm (or (cdr m) 0) |
(when (and (>= col 0) (< col (window-width))) |
502 |
col (- (car (posn-col-row end)) lm) |
(set ruler-mode-dragged-symbol newc))))) |
|
w (window-width) |
|
|
hs (window-hscroll) |
|
|
newc (+ col hs)) |
|
|
(if (and (>= col 0) (< (+ col lm rm) w)) |
|
|
(set ruler-mode-mouse-current-grab-object newc))))) |
|
503 |
|
|
504 |
(defun ruler-mode-mouse-add-tab-stop (start-event) |
(defun ruler-mode-mouse-add-tab-stop (start-event) |
505 |
"Add a tab stop to the graduation where the mouse pointer is on. |
"Add a tab stop to the graduation where the mouse pointer is on. |
506 |
START-EVENT is the mouse click event." |
START-EVENT is the mouse click event." |
507 |
(interactive "e") |
(interactive "e") |
508 |
(if ruler-mode-show-tab-stops |
(when ruler-mode-show-tab-stops |
509 |
(let* ((start (event-start start-event)) |
(let* ((start (event-start start-event)) |
510 |
(end (event-end start-event)) |
(end (event-end start-event)) |
511 |
m col w lm rm hs ts) |
col ts) |
512 |
(if (eq start end) ;; mouse click |
(when (eq start end) ;; mouse click |
513 |
(save-selected-window |
(save-selected-window |
514 |
(select-window (posn-window start)) |
(select-window (posn-window start)) |
515 |
(setq m (window-margins) |
(setq col (ruler-mode-window-col (car (posn-col-row start))) |
516 |
lm (or (car m) 0) |
ts (+ col (window-hscroll))) |
517 |
rm (or (cdr m) 0) |
(and (>= col 0) (< col (window-width)) |
518 |
col (- (car (posn-col-row start)) lm) |
(not (member ts tab-stop-list)) |
519 |
w (window-width) |
(progn |
520 |
hs (window-hscroll) |
(message "Tab stop set to %d" ts) |
521 |
ts (+ col hs)) |
(setq tab-stop-list (sort (cons ts tab-stop-list) |
522 |
(and (>= col 0) (< (+ col lm rm) w) |
#'<))))))))) |
|
(not (member ts tab-stop-list)) |
|
|
(progn |
|
|
(message "Tab stop set to %d" ts) |
|
|
(setq tab-stop-list |
|
|
(sort (cons ts tab-stop-list) |
|
|
#'<))))))))) |
|
523 |
|
|
524 |
(defun ruler-mode-mouse-del-tab-stop (start-event) |
(defun ruler-mode-mouse-del-tab-stop (start-event) |
525 |
"Delete tab stop at the graduation where the mouse pointer is on. |
"Delete tab stop at the graduation where the mouse pointer is on. |
526 |
START-EVENT is the mouse click event." |
START-EVENT is the mouse click event." |
527 |
(interactive "e") |
(interactive "e") |
528 |
(if ruler-mode-show-tab-stops |
(when ruler-mode-show-tab-stops |
529 |
(let* ((start (event-start start-event)) |
(let* ((start (event-start start-event)) |
530 |
(end (event-end start-event)) |
(end (event-end start-event)) |
531 |
m col w lm rm hs ts) |
col ts) |
532 |
(if (eq start end) ;; mouse click |
(when (eq start end) ;; mouse click |
533 |
(save-selected-window |
(save-selected-window |
534 |
(select-window (posn-window start)) |
(select-window (posn-window start)) |
535 |
(setq m (window-margins) |
(setq col (ruler-mode-window-col (car (posn-col-row start))) |
536 |
lm (or (car m) 0) |
ts (+ col (window-hscroll))) |
537 |
rm (or (cdr m) 0) |
(and (>= col 0) (< col (window-width)) |
538 |
col (- (car (posn-col-row start)) lm) |
(member ts tab-stop-list) |
539 |
w (window-width) |
(progn |
540 |
hs (window-hscroll) |
(message "Tab stop at %d deleted" ts) |
541 |
ts (+ col hs)) |
(setq tab-stop-list (delete ts tab-stop-list))))))))) |
|
(and (>= col 0) (< (+ col lm rm) w) |
|
|
(member ts tab-stop-list) |
|
|
(progn |
|
|
(message "Tab stop at %d deleted" ts) |
|
|
(setq tab-stop-list |
|
|
(delete ts tab-stop-list))))))))) |
|
542 |
|
|
543 |
(defun ruler-mode-toggle-show-tab-stops () |
(defun ruler-mode-toggle-show-tab-stops () |
544 |
"Toggle showing of tab stops on the ruler." |
"Toggle showing of tab stops on the ruler." |
594 |
;; the current one is the ruler header line format. |
;; the current one is the ruler header line format. |
595 |
(when (eq header-line-format ruler-mode-header-line-format) |
(when (eq header-line-format ruler-mode-header-line-format) |
596 |
(kill-local-variable 'header-line-format) |
(kill-local-variable 'header-line-format) |
597 |
(when ruler-mode-header-line-format-old |
(when (local-variable-p 'ruler-mode-header-line-format-old) |
598 |
(setq header-line-format ruler-mode-header-line-format-old))) |
(setq header-line-format ruler-mode-header-line-format-old))) |
599 |
(remove-hook 'post-command-hook ; remove local hook |
(remove-hook 'post-command-hook ; remove local hook |
600 |
#'force-mode-line-update t))) |
#'force-mode-line-update t))) |
640 |
mouse-2: unset goal column" |
mouse-2: unset goal column" |
641 |
"Help string shown when mouse is on the goal column character.") |
"Help string shown when mouse is on the goal column character.") |
642 |
|
|
643 |
(defconst ruler-mode-left-margin-help-echo |
(defconst ruler-mode-margin-help-echo |
644 |
"Left margin %S" |
"%s margin %S" |
645 |
"Help string shown when mouse is over the left margin area.") |
"Help string shown when mouse is over a margin area.") |
646 |
|
|
647 |
(defconst ruler-mode-right-margin-help-echo |
(defconst ruler-mode-fringe-help-echo |
648 |
"Right margin %S" |
"%s fringe %S" |
649 |
"Help string shown when mouse is over the right margin area.") |
"Help string shown when mouse is over a fringe area.") |
|
|
|
|
(defmacro ruler-mode-left-fringe-cols () |
|
|
"Return the width, measured in columns, of the left fringe area." |
|
|
'(round (or (frame-parameter nil 'left-fringe) 0) |
|
|
(frame-char-width))) |
|
|
|
|
|
(defmacro ruler-mode-right-fringe-cols () |
|
|
"Return the width, measured in columns, of the right fringe area." |
|
|
'(round (or (frame-parameter nil 'right-fringe) 0) |
|
|
(frame-char-width))) |
|
|
|
|
|
(defmacro ruler-mode-left-scroll-bar-cols () |
|
|
"Return the width, measured in columns, of the left vertical scrollbar." |
|
|
'(if (eq (frame-parameter nil 'vertical-scroll-bars) 'left) |
|
|
(let ((sbw (frame-parameter nil 'scroll-bar-width))) |
|
|
;; nil means it's a non-toolkit scroll bar, |
|
|
;; and its width in columns is 14 pixels rounded up. |
|
|
(unless sbw (setq sbw 14)) |
|
|
;; Always round up to multiple of columns. |
|
|
(ceiling sbw (frame-char-width))) |
|
|
0)) |
|
|
|
|
|
(defmacro ruler-mode-right-scroll-bar-cols () |
|
|
"Return the width, measured in columns, of the right vertical scrollbar." |
|
|
'(if (eq (frame-parameter nil 'vertical-scroll-bars) 'right) |
|
|
(round (or (frame-parameter nil 'scroll-bar-width) 0) |
|
|
(frame-char-width)) |
|
|
0)) |
|
650 |
|
|
651 |
(defun ruler-mode-ruler () |
(defun ruler-mode-ruler () |
652 |
"Return a string ruler." |
"Return a string ruler." |
653 |
(if ruler-mode |
(when ruler-mode |
654 |
(let* ((j (+ (ruler-mode-left-fringe-cols) |
(let* ((fullw (ruler-mode-full-window-width)) |
655 |
(ruler-mode-left-scroll-bar-cols))) |
(w (window-width)) |
656 |
(w (+ (window-width) j)) |
(m (window-margins)) |
657 |
(m (window-margins)) |
(lsb (ruler-mode-left-scroll-bar-cols)) |
658 |
(l (or (car m) 0)) |
(lf (ruler-mode-left-fringe-cols)) |
659 |
(r (or (cdr m) 0)) |
(lm (or (car m) 0)) |
660 |
(o (- (window-hscroll) l j)) |
(rsb (ruler-mode-right-scroll-bar-cols)) |
661 |
(i 0) |
(rf (ruler-mode-right-fringe-cols)) |
662 |
(ruler (concat |
(rm (or (cdr m) 0)) |
663 |
;; unit graduations |
(ruler (make-string fullw ruler-mode-basic-graduation-char)) |
664 |
(make-string w ruler-mode-basic-graduation-char) |
(o (+ lsb lf lm)) |
665 |
;; extra space to fill the header line |
(x 0) |
666 |
(make-string (+ (ruler-mode-right-fringe-cols) |
(i o) |
667 |
(ruler-mode-right-scroll-bar-cols)) |
(j (window-hscroll)) |
668 |
?\ ))) |
k c l1 l2 r2 r1 h1 h2 f1 f2) |
669 |
c k) |
|
670 |
|
;; Setup the default properties. |
671 |
;; Setup default face and help echo. |
(put-text-property 0 fullw 'face 'ruler-mode-default-face ruler) |
672 |
(put-text-property 0 (length ruler) |
(put-text-property 0 fullw |
673 |
'face 'ruler-mode-default-face |
'help-echo |
674 |
ruler) |
(cond |
675 |
(put-text-property 0 (length ruler) |
(ruler-mode-show-tab-stops |
676 |
'help-echo |
ruler-mode-ruler-help-echo-when-tab-stops) |
677 |
(if ruler-mode-show-tab-stops |
(goal-column |
678 |
ruler-mode-ruler-help-echo-when-tab-stops |
ruler-mode-ruler-help-echo-when-goal-column) |
679 |
(if goal-column |
(t |
680 |
ruler-mode-ruler-help-echo-when-goal-column |
ruler-mode-ruler-help-echo)) |
681 |
ruler-mode-ruler-help-echo)) |
ruler) |
682 |
ruler) |
;; Setup the local map. |
683 |
;; Setup the local map. |
(put-text-property 0 fullw 'local-map ruler-mode-map ruler) |
684 |
(put-text-property 0 (length ruler) |
|
685 |
'local-map ruler-mode-map |
;; Setup the active area. |
686 |
ruler) |
(while (< x w) |
687 |
|
;; Graduations. |
688 |
(setq j (+ l j)) |
(cond |
689 |
;; Setup the left margin area. |
;; Show a number graduation. |
690 |
(put-text-property |
((= (mod j 10) 0) |
691 |
i j 'face 'ruler-mode-margins-face |
(setq c (number-to-string (/ j 10)) |
692 |
ruler) |
m (length c) |
693 |
(put-text-property |
k i) |
694 |
i j 'help-echo (format ruler-mode-left-margin-help-echo l) |
(put-text-property |
695 |
ruler) |
i (1+ i) 'face 'ruler-mode-column-number-face |
696 |
(while (< i j) |
ruler) |
697 |
(aset ruler i ruler-mode-margins-char) |
(while (and (> m 0) (>= k 0)) |
698 |
(setq i (1+ i))) |
(aset ruler k (aref c (setq m (1- m)))) |
699 |
|
(setq k (1- k)))) |
700 |
;; Setup the ruler area. |
;; Show an intermediate graduation. |
701 |
(setq r (- w r)) |
((= (mod j 5) 0) |
702 |
(while (< i r) |
(aset ruler i ruler-mode-inter-graduation-char))) |
703 |
(setq j (+ i o)) |
;; Special columns. |
704 |
(cond |
(cond |
705 |
((= (mod j 10) 0) |
;; Show the `current-column' marker. |
706 |
(setq c (number-to-string (/ j 10)) |
((= j (current-column)) |
707 |
m (length c) |
(aset ruler i ruler-mode-current-column-char) |
708 |
k i) |
(put-text-property |
709 |
(put-text-property |
i (1+ i) 'face 'ruler-mode-current-column-face |
710 |
i (1+ i) 'face 'ruler-mode-column-number-face |
ruler)) |
711 |
ruler) |
;; Show the `goal-column' marker. |
712 |
(while (and (> m 0) (>= k 0)) |
((and goal-column (= j goal-column)) |
713 |
(aset ruler k (aref c (setq m (1- m)))) |
(aset ruler i ruler-mode-goal-column-char) |
714 |
(setq k (1- k))) |
(put-text-property |
715 |
) |
i (1+ i) 'face 'ruler-mode-goal-column-face |
716 |
((= (mod j 5) 0) |
ruler) |
717 |
(aset ruler i ruler-mode-inter-graduation-char) |
(put-text-property |
718 |
) |
i (1+ i) 'help-echo ruler-mode-goal-column-help-echo |
719 |
) |
ruler)) |
720 |
(setq i (1+ i))) |
;; Show the `comment-column' marker. |
721 |
|
((= j comment-column) |
722 |
;; Setup the right margin area. |
(aset ruler i ruler-mode-comment-column-char) |
723 |
(put-text-property |
(put-text-property |
724 |
i (length ruler) 'face 'ruler-mode-margins-face |
i (1+ i) 'face 'ruler-mode-comment-column-face |
725 |
ruler) |
ruler) |
726 |
(put-text-property |
(put-text-property |
727 |
i (length ruler) 'help-echo |
i (1+ i) 'help-echo ruler-mode-comment-column-help-echo |
728 |
(format ruler-mode-right-margin-help-echo (- w r)) |
ruler)) |
729 |
ruler) |
;; Show the `fill-column' marker. |
730 |
(while (< i (length ruler)) |
((= j fill-column) |
731 |
(aset ruler i ruler-mode-margins-char) |
(aset ruler i ruler-mode-fill-column-char) |
732 |
(setq i (1+ i))) |
(put-text-property |
733 |
|
i (1+ i) 'face 'ruler-mode-fill-column-face |
734 |
;; Show the `goal-column' marker. |
ruler) |
735 |
(if goal-column |
(put-text-property |
736 |
(progn |
i (1+ i) 'help-echo ruler-mode-fill-column-help-echo |
737 |
(setq i (- goal-column o)) |
ruler)) |
738 |
(and (>= i 0) (< i r) |
;; Show the `tab-stop-list' markers. |
739 |
(aset ruler i ruler-mode-goal-column-char) |
((and ruler-mode-show-tab-stops (member j tab-stop-list)) |
740 |
(progn |
(aset ruler i ruler-mode-tab-stop-char) |
741 |
(put-text-property |
(put-text-property |
742 |
i (1+ i) 'face 'ruler-mode-goal-column-face |
i (1+ i) 'face 'ruler-mode-tab-stop-face |
743 |
ruler) |
ruler))) |
744 |
(put-text-property |
(setq i (1+ i) |
745 |
i (1+ i) 'help-echo ruler-mode-goal-column-help-echo |
j (1+ j) |
746 |
ruler)) |
x (1+ x))) |
747 |
))) |
|
748 |
|
;; Highlight the fringes and margins. |
749 |
;; Show the `comment-column' marker. |
(if (nth 2 (window-fringes)) |
750 |
(setq i (- comment-column o)) |
;; fringes outside margins. |
751 |
(and (>= i 0) (< i r) |
(setq l1 lf |
752 |
(aset ruler i ruler-mode-comment-column-char) |
l2 lm |
753 |
(progn |
r2 rm |
754 |
(put-text-property |
r1 rf |
755 |
i (1+ i) 'face 'ruler-mode-comment-column-face |
h1 ruler-mode-fringe-help-echo |
756 |
ruler) |
h2 ruler-mode-margin-help-echo |
757 |
(put-text-property |
f1 'ruler-mode-fringes-face |
758 |
i (1+ i) 'help-echo ruler-mode-comment-column-help-echo |
f2 'ruler-mode-margins-face) |
759 |
ruler))) |
;; fringes inside margins. |
760 |
|
(setq l1 lm |
761 |
;; Show the `fill-column' marker. |
l2 lf |
762 |
(setq i (- fill-column o)) |
r2 rf |
763 |
(and (>= i 0) (< i r) |
r1 rm |
764 |
(aset ruler i ruler-mode-fill-column-char) |
h1 ruler-mode-margin-help-echo |
765 |
(progn (put-text-property |
h2 ruler-mode-fringe-help-echo |
766 |
i (1+ i) 'face 'ruler-mode-fill-column-face |
f1 'ruler-mode-margins-face |
767 |
ruler) |
f2 'ruler-mode-fringes-face)) |
768 |
(put-text-property |
(setq i lsb j (+ i l1)) |
769 |
i (1+ i) 'help-echo ruler-mode-fill-column-help-echo |
(put-text-property i j 'face f1 ruler) |
770 |
ruler))) |
(put-text-property i j 'help-echo (format h1 "Left" l1) ruler) |
771 |
|
(setq i j j (+ i l2)) |
772 |
;; Show the `tab-stop-list' markers. |
(put-text-property i j 'face f2 ruler) |
773 |
(if ruler-mode-show-tab-stops |
(put-text-property i j 'help-echo (format h2 "Left" l2) ruler) |
774 |
(let ((tsl tab-stop-list) ts) |
(setq i (+ o w) j (+ i r2)) |
775 |
(while tsl |
(put-text-property i j 'face f2 ruler) |
776 |
(setq ts (car tsl) |
(put-text-property i j 'help-echo (format h2 "Right" r2) ruler) |
777 |
tsl (cdr tsl) |
(setq i j j (+ i r1)) |
778 |
i (- ts o)) |
(put-text-property i j 'face f1 ruler) |
779 |
(and (>= i 0) (< i r) |
(put-text-property i j 'help-echo (format h1 "Right" r1) ruler) |
780 |
(aset ruler i ruler-mode-tab-stop-char) |
|
781 |
(put-text-property |
;; Show inactive areas. |
782 |
i (1+ i) |
(put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler) |
783 |
'face (cond |
(put-text-property j fullw 'face 'ruler-mode-pad-face ruler) |
|
;; Don't override the *-column face |
|
|
((eq ts fill-column) |
|
|
'ruler-mode-fill-column-face) |
|
|
((eq ts comment-column) |
|
|
'ruler-mode-comment-column-face) |
|
|
((eq ts goal-column) |
|
|
'ruler-mode-goal-column-face) |
|
|
(t |
|
|
'ruler-mode-tab-stop-face)) |
|
|
ruler))))) |
|
|
|
|
|
;; Show the `current-column' marker. |
|
|
(setq i (- (current-column) o)) |
|
|
(and (>= i 0) (< i r) |
|
|
(aset ruler i ruler-mode-current-column-char) |
|
|
(put-text-property |
|
|
i (1+ i) 'face 'ruler-mode-current-column-face |
|
|
ruler)) |
|
784 |
|
|
785 |
ruler))) |
;; Return the ruler propertized string. |
786 |
|
ruler))) |
787 |
|
|
788 |
(provide 'ruler-mode) |
(provide 'ruler-mode) |
789 |
|
|
791 |
;; coding: iso-latin-1 |
;; coding: iso-latin-1 |
792 |
;; End: |
;; End: |
793 |
|
|
794 |
|
;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8 |
795 |
;;; ruler-mode.el ends here |
;;; ruler-mode.el ends here |