26.1: calc-mode header line [PATCH]

[Boruch Baum <boruch_baum@gmx.com>]

[-- Attachment #1: Type: text/plain, Size: 1119 bytes --]

Back in version 21, emacs introduced a static 'header-line' that could
be inserted at the top of any buffer. Calc mode is one emacs package
that does not use it and could benefit from it, so the attached patch
offers that feature. The main benefit is that the 'calc trail' buffer
(what some greybeards from the mechanical age would remember as the
'tape reel') no longer has its title line scroll off the visible
window. The patch also includes:

1) Width-sensitive text for the header line, so that it is readable for
   very narrow windows, and scales to very wide windows.

2) Display of the 'calc trail' buffer when invoking calc from a frame
   that is split vertically (C-x 3, M-x split-window-right).

3) My version of emacs includes a unicode character at 'C-x 8 <return>
   POCKET CALCULATOR', that I did not include in the header line as the
   mode's icon, but that could be done.

The patch was diff'ed against the version of emacs that I have: the
latest-and-greatest that debian is distributing ... v26.1

--
hkp://keys.gnupg.net
CA45 09B5 5351 7C11 A9D1  7286 0036 9E45 1595 8BC0

[-- Attachment #2: calc.patch --]
[-- Type: text/x-diff, Size: 3417 bytes --]

--- calc.el	2020-08-30 15:03:07.563840474 -0400
+++ calc-new.el	2020-08-30 19:29:03.136433976 -0400
@@ -1410,15 +1410,30 @@
   (setq buffer-read-only t)
   (make-local-variable 'overlay-arrow-position)
   (make-local-variable 'overlay-arrow-string)
-  (when (= (buffer-size) 0)
-    (let ((buffer-read-only nil))
-      (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
+  (when calc-show-banner
+    (setq header-line-format
+      (let* ((fract  (/ (window-width) 3))
+             (factor (if (> fract 19) 22 10))
+             (size   (/ (- fract factor) 2))
+             (fill (make-string size ?-))
+             (pre  (replace-regexp-in-string ".$" " " fill))
+             (post (replace-regexp-in-string "^." " " fill)))
+        (concat pre (if (= factor 22) "Emacs Calculator Trail" "Calc Trail") post)))))

 (defun calc-create-buffer ()
   "Create and initialize a buffer for the Calculator."
   (set-buffer (get-buffer-create "*Calculator*"))
   (or (derived-mode-p 'calc-mode)
       (calc-mode))
+  (when calc-show-banner
+    (setq header-line-format
+      (let* ((fract  (/ (* (window-width) 2) 3))
+             (factor (if (> fract 22) 21 10))
+             (size   (/ (- fract factor) 2))
+             (fill (make-string size ?-))
+             (pre  (replace-regexp-in-string ".$" " " fill))
+             (post (replace-regexp-in-string "^." " " fill)))
+        (concat pre (if (= factor 21) "Emacs Calculator Mode" "Emacs Calc") post))))
   (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000))
   (when calc-always-load-extensions
     (require 'calc-ext))
@@ -1465,7 +1480,6 @@
                 (pop-to-buffer (current-buffer)))))))
       (with-current-buffer (calc-trail-buffer)
         (and calc-display-trail
-             (= (window-width) (frame-width))
              (calc-trail-display 1 t)))
       (message "Welcome to the GNU Emacs Calculator!  Press `?' or `h' for help, `q' to quit")
       (run-hooks 'calc-start-hook)
@@ -2000,13 +2014,8 @@
 	      (calc-any-evaltos nil))
 	 (setq calc-any-selections nil)
 	 (erase-buffer)
-	 (when calc-show-banner
-	   (insert (propertize "--- Emacs Calculator Mode ---\n"
-			       'face 'italic)))
 	 (while thing
 	   (goto-char (point-min))
-	   (when calc-show-banner
-	     (forward-line 1))
 	   (insert (math-format-stack-value (car thing)) "\n")
 	   (setq thing (cdr thing)))
 	 (calc-renumber-stack)
@@ -2091,7 +2100,6 @@
 	   (eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
       (with-current-buffer calc-trail-buffer
 	(goto-char (point-min))
-	(forward-line 1)
 	(setq calc-trail-pointer (point-marker))))
   calc-trail-buffer)

@@ -2159,10 +2167,8 @@
   (if (derived-mode-p 'calc-trail-mode)
       (progn
 	(beginning-of-line)
-	(if (bobp)
-	    (forward-line 1)
 	  (if (eobp)
-	      (forward-line -1)))
+          (forward-line -1))
 	(if (or (bobp) (eobp))
 	    (setq overlay-arrow-position nil)   ; trail is empty
 	  (set-marker calc-trail-pointer (point) (current-buffer))
@@ -2176,7 +2182,7 @@
 	    (if win
 		(save-excursion
 		  (forward-line (/ (window-height win) 2))
-		  (forward-line (- 1 (window-height win)))
+		  (forward-line (- 2 (window-height win)))
 		  (set-window-start win (point))
 		  (set-window-point win (+ calc-trail-pointer 4))
 		  (set-buffer calc-main-buffer)