lisp/calc/calc-trail.el

   1 ;;; calc-trail.el --- functions for manipulating the Calc "trail"
   2
   3 ;; Copyright (C) 1990-1993, 2001-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gillespie <daveg@synaptics.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 ;; This file is autoloaded from calc-ext.el.
  27
  28 (require 'calc-ext)
  29 (require 'calc-macs)
  30
  31 ;;; Trail commands.
  32
  33 (defun calc-trail-in ()
  34   (interactive)
  35   (let ((win (get-buffer-window (calc-trail-display t))))
  36     (and win (select-window win))))
  37
  38 (defun calc-trail-out ()
  39   (interactive)
  40   (calc-select-buffer)
  41   (let ((win (get-buffer-window (current-buffer))))
  42     (if win
  43         (progn
  44           (select-window win)
  45           (calc-align-stack-window))
  46       (calc))))
  47
  48 (defun calc-trail-next (n)
  49   (interactive "p")
  50   (calc-with-trail-buffer
  51    (forward-line n)
  52    (calc-trail-here)))
  53
  54 (defun calc-trail-previous (n)
  55   (interactive "p")
  56   (calc-with-trail-buffer
  57    (forward-line (- n))
  58    (calc-trail-here)))
  59
  60 (defun calc-trail-first (n)
  61   (interactive "p")
  62   (calc-with-trail-buffer
  63    (goto-char (point-min))
  64    (forward-line n)
  65    (calc-trail-here)))
  66
  67 (defun calc-trail-last (n)
  68   (interactive "p")
  69   (calc-with-trail-buffer
  70    (goto-char (point-max))
  71    (forward-line (- n))
  72    (calc-trail-here)))
  73
  74 (defun calc-trail-scroll-left (n)
  75   (interactive "P")
  76   (let ((curwin (selected-window)))
  77     (calc-with-trail-buffer
  78      (unwind-protect
  79          (progn
  80            (select-window (get-buffer-window (current-buffer)))
  81            (calc-scroll-left n))
  82        (select-window curwin)))))
  83
  84 (defun calc-trail-scroll-right (n)
  85   (interactive "P")
  86   (let ((curwin (selected-window)))
  87     (calc-with-trail-buffer
  88      (unwind-protect
  89          (progn
  90            (select-window (get-buffer-window (current-buffer)))
  91            (calc-scroll-right n))
  92        (select-window curwin)))))
  93
  94 (defun calc-trail-forward (n)
  95   (interactive "p")
  96   (calc-with-trail-buffer
  97    (forward-line (* n (1- (window-height))))
  98    (calc-trail-here)))
  99
 100 (defun calc-trail-backward (n)
 101   (interactive "p")
 102   (calc-with-trail-buffer
 103    (forward-line (- (* n (1- (window-height)))))
 104    (calc-trail-here)))
 105
 106 (defun calc-trail-isearch-forward ()
 107   (interactive)
 108   (calc-with-trail-buffer
 109    (let ((win (get-buffer-window (current-buffer)))
 110          pos)
 111      (save-window-excursion
 112        (select-window win)
 113        (isearch-forward)
 114        (setq pos (point)))
 115      (goto-char pos)
 116      (set-window-point win pos)
 117      (calc-trail-here))))
 118
 119 (defun calc-trail-isearch-backward ()
 120   (interactive)
 121   (calc-with-trail-buffer
 122    (let ((win (get-buffer-window (current-buffer)))
 123          pos)
 124      (save-window-excursion
 125        (select-window win)
 126        (isearch-backward)
 127        (setq pos (point)))
 128      (goto-char pos)
 129      (set-window-point win pos)
 130      (calc-trail-here))))
 131
 132 (defun calc-trail-yank (arg)
 133   (interactive "P")
 134   (calc-wrapper
 135    (or arg (calc-set-command-flag 'hold-trail))
 136    (calc-enter-result 0 "yank"
 137                       (calc-with-trail-buffer
 138                        (if arg
 139                            (forward-line (- (prefix-numeric-value arg))))
 140                        (if (or (looking-at "Emacs Calc")
 141                                (looking-at "----")
 142                                (looking-at " ? ? ?[^ \n]* *$")
 143                                (looking-at "..?.?$"))
 144                            (error "Can't yank that line"))
 145                        (if (looking-at ".*, \\.\\.\\., ")
 146                            (error "Can't yank (vector was abbreviated)"))
 147                        (forward-char 4)
 148                        (search-forward " ")
 149                        (let* ((next (save-excursion (forward-line 1) (point)))
 150                               (str (buffer-substring (point) (1- next)))
 151                               (val (with-current-buffer save-buf
 152                                      (math-read-plain-expr str))))
 153                          (if (eq (car-safe val) 'error)
 154                              (error "Can't yank that line: %s" (nth 2 val))
 155                            val))))))
 156
 157 (defun calc-trail-marker (str)
 158   (interactive "sText to insert in trail: ")
 159   (calc-with-trail-buffer
 160    (forward-line 1)
 161    (let ((buffer-read-only nil))
 162      (insert "---- " str "\n"))
 163    (forward-line -1)
 164    (calc-trail-here)))
 165
 166 (defun calc-trail-kill (n)
 167   (interactive "p")
 168   (calc-with-trail-buffer
 169    (let ((buffer-read-only nil))
 170      (save-restriction
 171        (narrow-to-region   ; don't delete "Emacs Trail" header
 172         (save-excursion
 173           (goto-char (point-min))
 174           (forward-line 1)
 175           (point))
 176         (point-max))
 177        (kill-line n)))
 178    (calc-trail-here)))
 179
 180 (provide 'calc-trail)
 181
 182 ;;; calc-trail.el ends here