1 |
;; Calculator for GNU Emacs, part II [calc-prog.el] |
;;; calc-prog.el --- user programmability functions for Calc |
2 |
|
|
3 |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
4 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
|
5 |
|
;; Author: David Gillespie <daveg@synaptics.com> |
6 |
|
;; Maintainer: Colin Walters <walters@debian.org> |
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
22 |
;; file named COPYING. Among other things, the copyright notice |
;; file named COPYING. Among other things, the copyright notice |
23 |
;; and this notice must be preserved on all copies. |
;; and this notice must be preserved on all copies. |
24 |
|
|
25 |
|
;;; Commentary: |
26 |
|
|
27 |
|
;;; Code: |
28 |
|
|
29 |
|
|
30 |
;; This file is autoloaded from calc-ext.el. |
;; This file is autoloaded from calc-ext.el. |
108 |
(calc-wrapper |
(calc-wrapper |
109 |
(calc-change-mode 'calc-timing n nil t) |
(calc-change-mode 'calc-timing n nil t) |
110 |
(message (if calc-timing |
(message (if calc-timing |
111 |
"Reporting timing of slow commands in Trail." |
"Reporting timing of slow commands in Trail" |
112 |
"Not reporting timing of commands.")))) |
"Not reporting timing of commands")))) |
113 |
|
|
114 |
(defun calc-pass-errors () |
(defun calc-pass-errors () |
115 |
(interactive) |
(interactive) |
122 |
(or (memq (car (car place)) '(error xxxerror)) |
(or (memq (car (car place)) '(error xxxerror)) |
123 |
(error "foo")) |
(error "foo")) |
124 |
(setcar (car place) 'xxxerror)) |
(setcar (car place) 'xxxerror)) |
125 |
(error (error "The calc-do function has been modified; unable to patch.")))) |
(error (error "The calc-do function has been modified; unable to patch")))) |
126 |
|
|
127 |
(defun calc-user-define () |
(defun calc-user-define () |
128 |
(interactive) |
(interactive) |
1112 |
(calc-pop-stack 1) |
(calc-pop-stack 1) |
1113 |
(if (math-is-true cond) |
(if (math-is-true cond) |
1114 |
(if defining-kbd-macro |
(if defining-kbd-macro |
1115 |
(message "If true...")) |
(message "If true..")) |
1116 |
(if defining-kbd-macro |
(if defining-kbd-macro |
1117 |
(message "Condition is false; skipping to Z: or Z] ...")) |
(message "Condition is false; skipping to Z: or Z] ...")) |
1118 |
(calc-kbd-skip-to-else-if t))))) |
(calc-kbd-skip-to-else-if t))))) |
1224 |
(null parts) |
(null parts) |
1225 |
(null counter) |
(null counter) |
1226 |
(progn |
(progn |
1227 |
(message "Warning: Infinite loop! Not executing.") |
(message "Warning: Infinite loop! Not executing") |
1228 |
(setq rpt-count 0))) |
(setq rpt-count 0))) |
1229 |
(or (not initial) dir |
(or (not initial) dir |
1230 |
(setq dir (math-compare final initial))) |
(setq dir (math-compare final initial))) |
1272 |
(let ((cond (calc-top-n 1))) |
(let ((cond (calc-top-n 1))) |
1273 |
(calc-pop-stack 1) |
(calc-pop-stack 1) |
1274 |
(if (math-is-true cond) |
(if (math-is-true cond) |
1275 |
(error "Keyboard macro aborted."))))) |
(error "Keyboard macro aborted"))))) |
1276 |
|
|
1277 |
|
|
1278 |
|
(defvar calc-kbd-push-level 0) |
1279 |
(defun calc-kbd-push (arg) |
(defun calc-kbd-push (arg) |
1280 |
(interactive "P") |
(interactive "P") |
1281 |
(calc-wrapper |
(calc-wrapper |
1331 |
(let ((calc-kbd-push-level (1+ calc-kbd-push-level))) |
(let ((calc-kbd-push-level (1+ calc-kbd-push-level))) |
1332 |
(message "Saving modes; type Z' to restore") |
(message "Saving modes; type Z' to restore") |
1333 |
(recursive-edit)))))) |
(recursive-edit)))))) |
|
(setq calc-kbd-push-level 0) |
|
1334 |
|
|
1335 |
(defun calc-kbd-pop () |
(defun calc-kbd-pop () |
1336 |
(interactive) |
(interactive) |
1679 |
|
|
1680 |
|
|
1681 |
|
|
|
|
|
1682 |
;;;; User-programmability. |
;;;; User-programmability. |
1683 |
|
|
1684 |
;;; Compiling Lisp-like forms to use the math library. |
;;; Compiling Lisp-like forms to use the math library. |
2123 |
(if (math-body-refers-to body 'math-break) |
(if (math-body-refers-to body 'math-break) |
2124 |
(cons 'catch (cons '(quote math-break) (list body))) |
(cons 'catch (cons '(quote math-break) (list body))) |
2125 |
body))) |
body))) |
2126 |
|
;; (put 'math-while 'lisp-indent-hook 1) |
2127 |
|
|
2128 |
(defmacro math-for (head &rest body) |
(defmacro math-for (head &rest body) |
2129 |
(let ((body (if head |
(let ((body (if head |
2132 |
(if (math-body-refers-to body 'math-break) |
(if (math-body-refers-to body 'math-break) |
2133 |
(cons 'catch (cons '(quote math-break) (list body))) |
(cons 'catch (cons '(quote math-break) (list body))) |
2134 |
body))) |
body))) |
2135 |
|
;; (put 'math-for 'lisp-indent-hook 1) |
2136 |
|
|
2137 |
(defun math-handle-for (head body) |
(defun math-handle-for (head body) |
2138 |
(let* ((var (nth 0 (car head))) |
(let* ((var (nth 0 (car head))) |
2190 |
var |
var |
2191 |
save-step))))))))))) |
save-step))))))))))) |
2192 |
|
|
|
|
|
2193 |
(defmacro math-foreach (head &rest body) |
(defmacro math-foreach (head &rest body) |
2194 |
(let ((body (math-handle-foreach head body))) |
(let ((body (math-handle-foreach head body))) |
2195 |
(if (math-body-refers-to body 'math-break) |
(if (math-body-refers-to body 'math-break) |
2196 |
(cons 'catch (cons '(quote math-break) (list body))) |
(cons 'catch (cons '(quote math-break) (list body))) |
2197 |
body))) |
body))) |
2198 |
|
;; (put 'math-foreach 'lisp-indent-hook 1) |
2199 |
|
|
2200 |
(defun math-handle-foreach (head body) |
(defun math-handle-foreach (head body) |
2201 |
(let ((var (nth 0 (car head))) |
(let ((var (nth 0 (car head))) |