mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Use a header line in calc mode instead of a regular in-buffer line

Browse Source 
* lisp/calc/calc.el (calc-trail-here): Use a header line.
(calc--header-line): New function.
(calc-trail-mode): Use a header line.
This commit is contained in:
Boruch Baum 2020-09-10 23:44:16 +02:00 committed by Lars Ingebrigtsen
parent a4d37877f8
commit 8e1376a391
1 changed files with 32 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
lisp/calc/calc.el
View File

@ -1382,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6
(set-keymap-parent map calc-mode-map)
map))
(defun calc--header-line (long short width &optional fudge)
"Return a Calc header line appropriate for the buffer width.
LONG is a desired text for a wide window, SHORT is a desired
abbreviated text, and width is the buffer width, which will be
some fraction of the 'parent' window width (At the time of
writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a
trial-and-error adjustment number for the edge-cases at the
border of the two cases."
;; TODO: This could be called as part of a 'window-resize' hook.
(setq header-line-format
(let* ((len-long (length long))
(len-short (length short))
(fudge (or fudge 0))
;; fudge for trail is: -3 (added to len-long)
;; (width ) for trail
(factor (if (> width (+ len-long fudge)) len-long len-short))
(size (/ (- width factor) 2))
(fill (make-string size ?-))
(pre (replace-regexp-in-string ".$" " " fill))
(post (replace-regexp-in-string "^." " " fill)))
(concat pre (if (= factor len-long) long short) post))))
(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail"
"Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
@ -1396,9 +1419,9 @@ commands given here will actually operate on the *Calculator* stack."
(setq buffer-read-only t)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
(when (= (buffer-size) 0)
(let ((inhibit-read-only t))
(insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
(when calc-show-banner
(calc--header-line "Emacs Calculator Trail" "Calc Trail"
(/ (window-width) 3) -3)))
(defun calc-create-buffer ()
"Create and initialize a buffer for the Calculator."
@ -1451,7 +1474,6 @@ commands given here will actually operate on the *Calculator* stack."
(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)
@ -1986,13 +2008,11 @@ See calc-keypad for details."
(calc-any-evaltos nil))
(setq calc-any-selections nil)
(erase-buffer)
(when calc-show-banner
(insert (propertize "--- Emacs Calculator Mode ---\n"
'face 'italic)))
(when calc-show-banner
(calc--header-line "Emacs Calculator Mode" "Emacs Calc"
(* 2 (/ (window-width) 3)) -3))
(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)
@ -2076,7 +2096,6 @@ the United States."
(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)
@ -2144,10 +2163,8 @@ the United States."
(if (derived-mode-p 'calc-trail-mode)
(progn
(beginning-of-line)
(if (bobp)
(forward-line 1)
(if (eobp)
(forward-line -1)))
(if (eobp)
(forward-line -1))
(if (or (bobp) (eobp))
(setq overlay-arrow-position nil) ; trail is empty
(set-marker calc-trail-pointer (point) (current-buffer))
@ -2161,7 +2178,7 @@ the United States."
(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)