code.delx.au - gnu-emacs/blob - lisp/calc/calc-trail.el

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