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) |