/[emacs]/emacs/lisp/ruler-mode.el
ViewVC logotype

Diff of /emacs/lisp/ruler-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.16 by fx, Thu Sep 4 16:23:25 2003 UTC revision 1.17 by rms, Mon Oct 20 23:27:52 2003 UTC
# Line 294  or remove a tab stop.  \\[ruler-mode-tog Line 294  or remove a tab stop.  \\[ruler-mode-tog
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."
# Line 647  mouse-2: unset goal column" Line 644  mouse-2: unset goal column"
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
# Line 680  mouse-2: unset goal column" Line 681  mouse-2: unset goal column"
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.
# Line 742  mouse-2: unset goal column" Line 743  mouse-2: unset goal column"
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))
# Line 765  mouse-2: unset goal column" Line 765  mouse-2: unset goal column"
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    

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26