diff options
Diffstat (limited to 'lisp/calc/calc.el')
| -rw-r--r-- | lisp/calc/calc.el | 123 |
1 files changed, 86 insertions, 37 deletions
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 648cb7bb807..5716189b342 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -884,6 +884,8 @@ Used by `calc-user-invocation'.") (defvar calc-load-hook nil "Hook run when calc.el is loaded.") +(make-obsolete-variable 'calc-load-hook + "use `with-eval-after-load' instead." "28.1") (defvar calc-window-hook nil "Hook called to create the Calc window.") @@ -1085,8 +1087,26 @@ Used by `calc-user-invocation'.") (append (where-is-internal 'delete-backward-char global-map) (where-is-internal 'backward-delete-char global-map) (where-is-internal 'backward-delete-char-untabify global-map) - '("\C-d")) - '("\177" "\C-d"))) + '("\177")) + '("\177"))) + +(mapc (lambda (x) + (ignore-errors + (define-key calc-digit-map x 'calcDigit-delchar) + (define-key calc-mode-map x 'calc-pop) + (define-key calc-mode-map + (if (and (vectorp x) (featurep 'xemacs)) + (if (= (length x) 1) + (vector (if (consp (aref x 0)) + (cons 'meta (aref x 0)) + (list 'meta (aref x 0)))) + "\e\C-d") + (vconcat "\e" x)) + 'calc-pop-above))) + (if calc-scan-for-dels + (append (where-is-internal 'delete-forward-char global-map) + '("\C-d")) + '("\C-d"))) (defvar calc-dispatch-map (let ((map (make-keymap))) @@ -1362,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 (max (/ (- width factor) 2) 0)) + (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 @@ -1376,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." @@ -1392,6 +1435,12 @@ commands given here will actually operate on the *Calculator* stack." (require 'calc-ext) (calc-set-language calc-language calc-language-option t))) +(defcustom calc-make-windows-dedicated t + "If non-nil, windows displaying Calc buffers will be marked dedicated. +See `window-dedicated-p' for what that means." + :version "28.1" + :type 'boolean) + ;;;###autoload (defun calc (&optional arg full-display interactive) "The Emacs Calculator. Full documentation is listed under `calc-mode'." @@ -1431,13 +1480,14 @@ 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) (and (windowp full-display) (window-point full-display) (select-window full-display)) + (and calc-make-windows-dedicated + (set-window-dedicated-p nil t)) (calc-check-defines) (when (and calc-said-hello interactive) (sit-for 2) @@ -1966,13 +2016,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) @@ -2056,7 +2104,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) @@ -2101,7 +2148,9 @@ the United States." (if calc-trail-window-hook (run-hooks 'calc-trail-window-hook) (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) - (set-window-buffer w calc-trail-buffer))) + (set-window-buffer w calc-trail-buffer) + (and calc-make-windows-dedicated + (set-window-dedicated-p nil t)))) (calc-wrapper (setq overlay-arrow-string calc-trail-overlay overlay-arrow-position calc-trail-pointer) @@ -2124,10 +2173,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)) @@ -2141,7 +2188,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) @@ -2276,7 +2323,7 @@ the United States." ((eq last-command-event ?@) "0@ ") (t (char-to-string last-command-event)))) -(defvar calc-buffer) +(defvar calc-buffer nil) (defvar calc-prev-char) (defvar calc-prev-prev-char) (defvar calc-digit-value) @@ -2316,7 +2363,7 @@ the United States." (defun calcDigit-nondigit () (interactive) ;; Exercise for the reader: Figure out why this is a good precaution! - (or (boundp 'calc-buffer) + (or calc-buffer (use-local-map minibuffer-local-map)) (let ((str (minibuffer-contents))) (setq calc-digit-value (with-current-buffer calc-buffer @@ -2341,7 +2388,6 @@ the United States." (defun calcDigit-key () (interactive) - (goto-char (point-max)) (if (or (and (memq last-command-event '(?+ ?-)) (> (buffer-size) 0) (/= (preceding-char) ?e)) @@ -2384,8 +2430,7 @@ the United States." (delete-char 1)) (if (looking-at "-") (delete-char 1) - (insert "-"))) - (goto-char (point-max))) + (insert "-")))) ((eq last-command-event ?p) (if (or (calc-minibuffer-contains ".*\\+/-.*") (calc-minibuffer-contains ".*mod.*") @@ -2427,7 +2472,7 @@ the United States." (if (and (memq last-command-event '(?@ ?o ?h ?\' ?m)) (string-match " " calc-hms-format)) (insert " ")) - (if (and (eq this-command last-command) + (if (and (memq last-command '(calcDigit-start calcDigit-key)) (eq last-command-event ?.)) (progn (require 'calc-ext) @@ -2438,17 +2483,9 @@ the United States." (setq calc-prev-prev-char calc-prev-char calc-prev-char last-command-event)) - (defun calcDigit-backspace () (interactive) - (goto-char (point-max)) - (cond ((calc-minibuffer-contains ".* \\+/- \\'") - (backward-delete-char 5)) - ((calc-minibuffer-contains ".* mod \\'") - (backward-delete-char 5)) - ((calc-minibuffer-contains ".* \\'") - (backward-delete-char 2)) - ((eq last-command 'calcDigit-start) + (cond ((eq last-command 'calcDigit-start) (erase-buffer)) (t (backward-delete-char 1))) (if (= (calc-minibuffer-size) 0) @@ -2923,6 +2960,20 @@ the United States." (- (- (nth 2 a) (nth 2 b)) ldiff)))) +(defun calcDigit-delchar () + (interactive) + (cond ((looking-at-p " \\+/- \\'") + (delete-char 5)) + ((looking-at-p " mod \\'") + (delete-char 5)) + ((looking-at-p " \\'") + (delete-char 2)) + ((eq last-command 'calcDigit-start) + (erase-buffer)) + (t (unless (eobp) (delete-char 1)))) + (when (= (calc-minibuffer-size) 0) + (setq last-command-event 13) + (calcDigit-nondigit))) (defvar math-comp-selected) @@ -3411,12 +3462,10 @@ See Info node `(calc)Defining Functions'." (defun calc-clear-unread-commands () (setq unread-command-events nil)) -(defcalcmodevar math-2-word-size - (math-read-number-simple "4294967296") +(defcalcmodevar math-2-word-size 4294967296 "Two to the power of `calc-word-size'.") -(defcalcmodevar math-half-2-word-size - (math-read-number-simple "2147483648") +(defcalcmodevar math-half-2-word-size 2147483648 "One-half of two to the power of `calc-word-size'.") (when calc-always-load-extensions |