/[emacs]/emacs/lisp/calc/calc-prog.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-prog.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by walters, Wed Nov 14 09:06:43 2001 UTC revision 1.4 by walters, Mon Nov 19 07:37:27 2001 UTC
# Line 1  Line 1 
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    
# Line 19  Line 22 
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.
# Line 102  Line 108 
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)
# Line 116  Line 122 
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)
# Line 1106  Line 1112 
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)))))
# Line 1218  Line 1224 
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)))
# Line 1266  Line 1272 
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
# Line 1324  Line 1331 
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)
# Line 1673  Line 1679 
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.
# Line 2118  Line 2123 
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
# Line 2127  Line 2132 
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)))
# Line 2184  Line 2190 
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)))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26