Mercurial > emacs
changeset 52889:615ebe291578
(ruler-mode-left-fringe-cols): Add new optional
argument REAL, to return a real number instead of a rounded
integer value. Define as inline function.
(ruler-mode-right-fringe-cols): Likewise.
(ruler-mode-scroll-bar-cols): New function.
(ruler-mode-left-scroll-bar-cols): Use it. Define as macro.
(ruler-mode-right-scroll-bar-cols): Likewise.
(ruler-mode-space): New function.
(ruler-mode-ruler): Use it. Handle variations of fringe style,
scroll bar mode and margins in a more robust way.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 20 Oct 2003 23:27:52 +0000 |
parents | bc07c51257ae |
children | 51328ad3b6be |
files | lisp/ruler-mode.el |
diffstat | 1 files changed, 60 insertions(+), 69 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ruler-mode.el Mon Oct 20 23:16:26 2003 +0000 +++ b/lisp/ruler-mode.el Mon Oct 20 23:27:52 2003 +0000 @@ -294,49 +294,46 @@ "Face used to highlight the `current-column' character." :group 'ruler-mode) -(defmacro ruler-mode-left-fringe-cols () - "Return the width, measured in columns, of the left fringe area." - '(ceiling (or (car (window-fringes)) 0) - (frame-char-width))) +(defsubst ruler-mode-left-fringe-cols (&optional real) + "Return the width, measured in columns, of the left fringe area. +If optional argument REAL is non-nil, return a real floating point +number instead of a rounded integer value." + (funcall (if real '/ 'ceiling) + (or (car (window-fringes)) 0) + (float (frame-char-width)))) -(defmacro ruler-mode-right-fringe-cols () - "Return the width, measured in columns, of the right fringe area." - '(ceiling (or (nth 1 (window-fringes)) 0) - (frame-char-width))) +(defsubst ruler-mode-right-fringe-cols (&optional real) + "Return the width, measured in columns, of the right fringe area. +If optional argument REAL is non-nil, return a real floating point +number instead of a rounded integer value." + (funcall (if real '/ 'ceiling) + (or (nth 1 (window-fringes)) 0) + (float (frame-char-width)))) -(defun ruler-mode-left-scroll-bar-cols () - "Return the width, measured in columns, of the right vertical scrollbar." +(defun ruler-mode-scroll-bar-cols (side) + "Return the width, measured in columns, of the vertical scrollbar on SIDE. +SIDE must be the symbol `left' or `right'." (let* ((wsb (window-scroll-bars)) (vtype (nth 2 wsb)) (cols (nth 1 wsb))) - (if (or (eq vtype 'left) - (and (eq vtype t) - (eq (frame-parameter nil 'vertical-scroll-bars) 'left))) - (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))) + (cond + ((not (memq side '(left right))) + (error "`left' or `right' expected instead of %S" side)) + ((and (eq vtype side) cols)) + ((eq (frame-parameter nil 'vertical-scroll-bars) side) + ;; nil means it's a non-toolkit scroll bar, and its width in + ;; columns is 14 pixels rounded up. + (ceiling (or (frame-parameter nil 'scroll-bar-width) 14) + (frame-char-width))) + (0)))) -(defun ruler-mode-right-scroll-bar-cols () +(defmacro ruler-mode-right-scroll-bar-cols () "Return the width, measured in columns, of the right vertical scrollbar." - (let* ((wsb (window-scroll-bars)) - (vtype (nth 2 wsb)) - (cols (nth 1 wsb))) - (if (or (eq vtype 'right) - (and (eq vtype t) - (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))) + '(ruler-mode-scroll-bar-cols 'right)) + +(defmacro ruler-mode-left-scroll-bar-cols () + "Return the width, measured in columns, of the left vertical scrollbar." + '(ruler-mode-scroll-bar-cols 'left)) (defsubst ruler-mode-full-window-width () "Return the full width of the selected window." @@ -647,29 +644,33 @@ (defconst ruler-mode-fringe-help-echo "%s fringe %S" "Help string shown when mouse is over a fringe area.") + +(defsubst ruler-mode-space (width &rest props) + "Return a single space string of WIDTH times the normal character width. +Optional argument PROPS specifies other text properties to apply." + (if (> width 0) + (apply 'propertize " " 'display (list 'space :width width) props) + "")) (defun ruler-mode-ruler () "Return a string ruler." (when ruler-mode - (let* ((fullw (ruler-mode-full-window-width)) - (w (window-width)) + (let* ((w (window-width)) (m (window-margins)) (lsb (ruler-mode-left-scroll-bar-cols)) - (lf (ruler-mode-left-fringe-cols)) + (lf (ruler-mode-left-fringe-cols t)) (lm (or (car m) 0)) (rsb (ruler-mode-right-scroll-bar-cols)) - (rf (ruler-mode-right-fringe-cols)) + (rf (ruler-mode-right-fringe-cols t)) (rm (or (cdr m) 0)) - (ruler (make-string fullw ruler-mode-basic-graduation-char)) - (o (+ lsb lf lm)) - (x 0) - (i o) + (ruler (make-string w ruler-mode-basic-graduation-char)) + (i 0) (j (window-hscroll)) k c l1 l2 r2 r1 h1 h2 f1 f2) ;; Setup the default properties. - (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler) - (put-text-property 0 fullw + (put-text-property 0 w 'face 'ruler-mode-default-face ruler) + (put-text-property 0 w 'help-echo (cond (ruler-mode-show-tab-stops @@ -680,10 +681,10 @@ ruler-mode-ruler-help-echo)) ruler) ;; Setup the local map. - (put-text-property 0 fullw 'local-map ruler-mode-map ruler) + (put-text-property 0 w 'local-map ruler-mode-map ruler) ;; Setup the active area. - (while (< x w) + (while (< i w) ;; Graduations. (cond ;; Show a number graduation. @@ -742,8 +743,7 @@ i (1+ i) 'face 'ruler-mode-tab-stop-face ruler))) (setq i (1+ i) - j (1+ j) - x (1+ x))) + j (1+ j))) ;; Highlight the fringes and margins. (if (nth 2 (window-fringes)) @@ -765,25 +765,16 @@ h2 ruler-mode-fringe-help-echo f1 'ruler-mode-margins-face f2 'ruler-mode-fringes-face)) - (setq i lsb j (+ i l1)) - (put-text-property i j 'face f1 ruler) - (put-text-property i j 'help-echo (format h1 "Left" l1) ruler) - (setq i j j (+ i l2)) - (put-text-property i j 'face f2 ruler) - (put-text-property i j 'help-echo (format h2 "Left" l2) ruler) - (setq i (+ o w) j (+ i r2)) - (put-text-property i j 'face f2 ruler) - (put-text-property i j 'help-echo (format h2 "Right" r2) ruler) - (setq i j j (+ i r1)) - (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))) + ;; Return the ruler propertized string. Using list here, + ;; instead of concat visually separate the different areas. + (list + (ruler-mode-space lsb 'face 'ruler-mode-pad-face) + (ruler-mode-space l1 'face f1 'help-echo (format h1 "Left" l1)) + (ruler-mode-space l2 'face f2 'help-echo (format h2 "Left" l2)) + ruler + (ruler-mode-space r2 'face f2 'help-echo (format h2 "Right" r2)) + (ruler-mode-space r1 'face f1 'help-echo (format h1 "Right" r1)) + (ruler-mode-space rsb 'face 'ruler-mode-pad-face))))) (provide 'ruler-mode)