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 () |
(defsubst ruler-mode-left-fringe-cols (&optional real) |
298 |
"Return the width, measured in columns, of the left fringe area." |
"Return the width, measured in columns, of the left fringe area. |
299 |
'(ceiling (or (car (window-fringes)) 0) |
If optional argument REAL is non-nil, return a real floating point |
300 |
(frame-char-width))) |
number instead of a rounded integer value." |
301 |
|
(funcall (if real '/ 'ceiling) |
302 |
(defmacro ruler-mode-right-fringe-cols () |
(or (car (window-fringes)) 0) |
303 |
"Return the width, measured in columns, of the right fringe area." |
(float (frame-char-width)))) |
304 |
'(ceiling (or (nth 1 (window-fringes)) 0) |
|
305 |
(frame-char-width))) |
(defsubst ruler-mode-right-fringe-cols (&optional real) |
306 |
|
"Return the width, measured in columns, of the right fringe area. |
307 |
(defun ruler-mode-left-scroll-bar-cols () |
If optional argument REAL is non-nil, return a real floating point |
308 |
"Return the width, measured in columns, of the right vertical scrollbar." |
number instead of a rounded integer value." |
309 |
|
(funcall (if real '/ 'ceiling) |
310 |
|
(or (nth 1 (window-fringes)) 0) |
311 |
|
(float (frame-char-width)))) |
312 |
|
|
313 |
|
(defun ruler-mode-scroll-bar-cols (side) |
314 |
|
"Return the width, measured in columns, of the vertical scrollbar on SIDE. |
315 |
|
SIDE must be the symbol `left' or `right'." |
316 |
(let* ((wsb (window-scroll-bars)) |
(let* ((wsb (window-scroll-bars)) |
317 |
(vtype (nth 2 wsb)) |
(vtype (nth 2 wsb)) |
318 |
(cols (nth 1 wsb))) |
(cols (nth 1 wsb))) |
319 |
(if (or (eq vtype 'left) |
(cond |
320 |
(and (eq vtype t) |
((not (memq side '(left right))) |
321 |
(eq (frame-parameter nil 'vertical-scroll-bars) 'left))) |
(error "`left' or `right' expected instead of %S" side)) |
322 |
(or cols |
((and (eq vtype side) cols)) |
323 |
(ceiling |
((eq (frame-parameter nil 'vertical-scroll-bars) side) |
324 |
;; nil means it's a non-toolkit scroll bar, |
;; nil means it's a non-toolkit scroll bar, and its width in |
325 |
;; and its width in columns is 14 pixels rounded up. |
;; columns is 14 pixels rounded up. |
326 |
(or (frame-parameter nil 'scroll-bar-width) 14) |
(ceiling (or (frame-parameter nil 'scroll-bar-width) 14) |
327 |
;; Always round up to multiple of columns. |
(frame-char-width))) |
328 |
(frame-char-width))) |
(0)))) |
|
0))) |
|
329 |
|
|
330 |
(defun ruler-mode-right-scroll-bar-cols () |
(defmacro ruler-mode-right-scroll-bar-cols () |
331 |
"Return the width, measured in columns, of the right vertical scrollbar." |
"Return the width, measured in columns, of the right vertical scrollbar." |
332 |
(let* ((wsb (window-scroll-bars)) |
'(ruler-mode-scroll-bar-cols 'right)) |
333 |
(vtype (nth 2 wsb)) |
|
334 |
(cols (nth 1 wsb))) |
(defmacro ruler-mode-left-scroll-bar-cols () |
335 |
(if (or (eq vtype 'right) |
"Return the width, measured in columns, of the left vertical scrollbar." |
336 |
(and (eq vtype t) |
'(ruler-mode-scroll-bar-cols 'left)) |
|
(eq (frame-parameter nil 'vertical-scroll-bars) 'right))) |
|
|
(or cols |
|
|
(ceiling |
|
|
;; nil means it's a non-toolkit scroll bar, |
|
|
;; and its width in columns is 14 pixels rounded up. |
|
|
(or (frame-parameter nil 'scroll-bar-width) 14) |
|
|
;; Always round up to multiple of columns. |
|
|
(frame-char-width))) |
|
|
0))) |
|
337 |
|
|
338 |
(defsubst ruler-mode-full-window-width () |
(defsubst ruler-mode-full-window-width () |
339 |
"Return the full width of the selected window." |
"Return the full width of the selected window." |
644 |
(defconst ruler-mode-fringe-help-echo |
(defconst ruler-mode-fringe-help-echo |
645 |
"%s fringe %S" |
"%s fringe %S" |
646 |
"Help string shown when mouse is over a fringe area.") |
"Help string shown when mouse is over a fringe area.") |
647 |
|
|
648 |
|
(defsubst ruler-mode-space (width &rest props) |
649 |
|
"Return a single space string of WIDTH times the normal character width. |
650 |
|
Optional argument PROPS specifies other text properties to apply." |
651 |
|
(if (> width 0) |
652 |
|
(apply 'propertize " " 'display (list 'space :width width) props) |
653 |
|
"")) |
654 |
|
|
655 |
(defun ruler-mode-ruler () |
(defun ruler-mode-ruler () |
656 |
"Return a string ruler." |
"Return a string ruler." |
657 |
(when ruler-mode |
(when ruler-mode |
658 |
(let* ((fullw (ruler-mode-full-window-width)) |
(let* ((w (window-width)) |
|
(w (window-width)) |
|
659 |
(m (window-margins)) |
(m (window-margins)) |
660 |
(lsb (ruler-mode-left-scroll-bar-cols)) |
(lsb (ruler-mode-left-scroll-bar-cols)) |
661 |
(lf (ruler-mode-left-fringe-cols)) |
(lf (ruler-mode-left-fringe-cols t)) |
662 |
(lm (or (car m) 0)) |
(lm (or (car m) 0)) |
663 |
(rsb (ruler-mode-right-scroll-bar-cols)) |
(rsb (ruler-mode-right-scroll-bar-cols)) |
664 |
(rf (ruler-mode-right-fringe-cols)) |
(rf (ruler-mode-right-fringe-cols t)) |
665 |
(rm (or (cdr m) 0)) |
(rm (or (cdr m) 0)) |
666 |
(ruler (make-string fullw ruler-mode-basic-graduation-char)) |
(ruler (make-string w ruler-mode-basic-graduation-char)) |
667 |
(o (+ lsb lf lm)) |
(i 0) |
|
(x 0) |
|
|
(i o) |
|
668 |
(j (window-hscroll)) |
(j (window-hscroll)) |
669 |
k c l1 l2 r2 r1 h1 h2 f1 f2) |
k c l1 l2 r2 r1 h1 h2 f1 f2) |
670 |
|
|
671 |
;; Setup the default properties. |
;; Setup the default properties. |
672 |
(put-text-property 0 fullw 'face 'ruler-mode-default-face ruler) |
(put-text-property 0 w 'face 'ruler-mode-default-face ruler) |
673 |
(put-text-property 0 fullw |
(put-text-property 0 w |
674 |
'help-echo |
'help-echo |
675 |
(cond |
(cond |
676 |
(ruler-mode-show-tab-stops |
(ruler-mode-show-tab-stops |
681 |
ruler-mode-ruler-help-echo)) |
ruler-mode-ruler-help-echo)) |
682 |
ruler) |
ruler) |
683 |
;; Setup the local map. |
;; Setup the local map. |
684 |
(put-text-property 0 fullw 'local-map ruler-mode-map ruler) |
(put-text-property 0 w 'local-map ruler-mode-map ruler) |
685 |
|
|
686 |
;; Setup the active area. |
;; Setup the active area. |
687 |
(while (< x w) |
(while (< i w) |
688 |
;; Graduations. |
;; Graduations. |
689 |
(cond |
(cond |
690 |
;; Show a number graduation. |
;; Show a number graduation. |
743 |
i (1+ i) 'face 'ruler-mode-tab-stop-face |
i (1+ i) 'face 'ruler-mode-tab-stop-face |
744 |
ruler))) |
ruler))) |
745 |
(setq i (1+ i) |
(setq i (1+ i) |
746 |
j (1+ j) |
j (1+ j))) |
|
x (1+ x))) |
|
747 |
|
|
748 |
;; Highlight the fringes and margins. |
;; Highlight the fringes and margins. |
749 |
(if (nth 2 (window-fringes)) |
(if (nth 2 (window-fringes)) |
765 |
h2 ruler-mode-fringe-help-echo |
h2 ruler-mode-fringe-help-echo |
766 |
f1 'ruler-mode-margins-face |
f1 'ruler-mode-margins-face |
767 |
f2 'ruler-mode-fringes-face)) |
f2 'ruler-mode-fringes-face)) |
768 |
(setq i lsb j (+ i l1)) |
;; Return the ruler propertized string. Using list here, |
769 |
(put-text-property i j 'face f1 ruler) |
;; instead of concat visually separate the different areas. |
770 |
(put-text-property i j 'help-echo (format h1 "Left" l1) ruler) |
(list |
771 |
(setq i j j (+ i l2)) |
(ruler-mode-space lsb 'face 'ruler-mode-pad-face) |
772 |
(put-text-property i j 'face f2 ruler) |
(ruler-mode-space l1 'face f1 'help-echo (format h1 "Left" l1)) |
773 |
(put-text-property i j 'help-echo (format h2 "Left" l2) ruler) |
(ruler-mode-space l2 'face f2 'help-echo (format h2 "Left" l2)) |
774 |
(setq i (+ o w) j (+ i r2)) |
ruler |
775 |
(put-text-property i j 'face f2 ruler) |
(ruler-mode-space r2 'face f2 'help-echo (format h2 "Right" r2)) |
776 |
(put-text-property i j 'help-echo (format h2 "Right" r2) ruler) |
(ruler-mode-space r1 'face f1 'help-echo (format h1 "Right" r1)) |
777 |
(setq i j j (+ i r1)) |
(ruler-mode-space rsb 'face 'ruler-mode-pad-face))))) |
|
(put-text-property i j 'face f1 ruler) |
|
|
(put-text-property i j 'help-echo (format h1 "Right" r1) ruler) |
|
|
|
|
|
;; Show inactive areas. |
|
|
(put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler) |
|
|
(put-text-property j fullw 'face 'ruler-mode-pad-face ruler) |
|
|
|
|
|
;; Return the ruler propertized string. |
|
|
ruler))) |
|
778 |
|
|
779 |
(provide 'ruler-mode) |
(provide 'ruler-mode) |
780 |
|
|