/[emacs]/emacs/lisp/ses.el
ViewVC logotype

Diff of /emacs/lisp/ses.el

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

revision 1.1 by JYavner, Sat Sep 28 18:45:54 2002 UTC revision 1.2 by JYavner, Sun Feb 2 19:16:23 2003 UTC
# Line 1605  narrows the buffer now." Line 1605  narrows the buffer now."
1605       (message (error-message-string err))))       (message (error-message-string err))))
1606    nil) ;Make coverage-tester happy    nil) ;Make coverage-tester happy
1607    
1608    (defun ses-header-string-left-offset ()
1609      "Number of characters in left fringe and left scrollbar (if any)."
1610      (let ((left-fringe    (round (or (frame-parameter nil 'left-fringe) 0)
1611                                   (frame-char-width)))
1612            (left-scrollbar (if (not (eq (frame-parameter nil
1613                                                          'vertical-scroll-bars)
1614                                         'left))
1615                                0
1616                              (let ((x (frame-parameter nil 'scroll-bar-width)))
1617                                ;;Non-toolkil bar is always 14 pixels?
1618                                (unless x (setq x 14))
1619                                ;;Always round up
1620                                (ceiling x (frame-char-width))))))
1621        (+ left-fringe left-scrollbar)))
1622    
1623  (defun ses-create-header-string ()  (defun ses-create-header-string ()
1624    "Sets up `header-string' as the buffer's header line, based on the    "Sets up `header-string' as the buffer's header line, based on the
1625  current set of columns and window-scroll position."  current set of columns and window-scroll position."
1626    (let ((totwidth (- 1 (window-hscroll)))    (let* ((left-offset (ses-header-string-left-offset))
1627          result width result x)           (totwidth (- left-offset (window-hscroll)))
1628      (if window-system           result width result x)
1629          ;;Leave room for the left-side fringe      ;;Leave room for the left-side fringe and scrollbar
1630          (push " " result))      (push (make-string left-offset ? ) result)
1631      (dotimes (col numcols)      (dotimes (col numcols)
1632        (setq width    (ses-col-width col)        (setq width    (ses-col-width col)
1633              totwidth (+ totwidth width 1))              totwidth (+ totwidth width 1))
1634        (if (= totwidth 2) ;Scrolled so intercolumn space is leftmost        (if (= totwidth (+ left-offset 1))
1635              ;;Scrolled so intercolumn space is leftmost
1636            (push " " result))            (push " " result))
1637        (when (> totwidth 2)        (when (> totwidth (+ left-offset 1))
1638          (if (> header-row 0)          (if (> header-row 0)
1639              (save-excursion              (save-excursion
1640                (ses-goto-print (1- header-row) col)                (ses-goto-print (1- header-row) col)
1641                (setq x (buffer-substring-no-properties (point)                (setq x (buffer-substring-no-properties (point)
1642                                                        (+ (point) width)))                                                        (+ (point) width)))
1643                (if (>= width (1- totwidth))                (if (>= width (- totwidth left-offset))
1644                    (setq x (substring x (- width totwidth -2))))                    (setq x (substring x (- width totwidth left-offset -1))))
1645                (push (propertize x 'face ses-box-prop) result))                (push (propertize x 'face ses-box-prop) result))
1646            (setq x (ses-column-letter col))            (setq x (ses-column-letter col))
1647            (push (propertize x 'face ses-box-prop) result)            (push (propertize x 'face ses-box-prop) result)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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