comparison lisp/calc/calc-prog.el @ 41271:fcd507927105

Change all toplevel `setq' forms to `defvar' forms, and move them before their first use. Use `when', `unless'. Remove trailing periods from error forms. Add description and headers suggested by Emacs Lisp coding conventions.

41270:711f18abaf57

;; Calculator for GNU Emacs, part II [calc-prog.el]
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, [e-mail].

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor

;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.



;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

(defun calc-timing (n)
  (interactive "P")
  (calc-wrapper
   (calc-change-mode 'calc-timing n nil t)
   (message (if calc-timing
		"Reporting timing of slow commands in Trail."
	      "Not reporting timing of commands."))))

(defun calc-pass-errors ()
  (interactive)
  ;; The following two cases are for the new, optimizing byte compiler
  ;; or the standard 18.57 byte compiler, respectively.

	(or (memq (car-safe (car-safe place)) '(error xxxerror))
	    (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27)))
	(or (memq (car (car place)) '(error xxxerror))
	    (error "foo"))
	(setcar (car place) 'xxxerror))
    (error (error "The calc-do function has been modified; unable to patch."))))

(defun calc-user-define ()
  (interactive)
  (message "Define user key: z-")
  (let ((key (read-char)))

  (calc-wrapper
   (let ((cond (calc-top-n 1)))
     (calc-pop-stack 1)
     (if (math-is-true cond)
	 (if defining-kbd-macro
	     (message "If true..."))
       (if defining-kbd-macro
	   (message "Condition is false; skipping to Z: or Z] ..."))
       (calc-kbd-skip-to-else-if t)))))

(defun calc-kbd-else-if ()

    (and (not executing-kbd-macro)
	 (= rpt-count 1000000)
	 (null parts)
	 (null counter)
	 (progn
	   (message "Warning: Infinite loop!  Not executing.")
	   (setq rpt-count 0)))
    (or (not initial) dir
	(setq dir (math-compare final initial)))
    (calc-wrapper
     (while (> rpt-count 0)

  (interactive)
  (calc-wrapper
   (let ((cond (calc-top-n 1)))
     (calc-pop-stack 1)
     (if (math-is-true cond)
	 (error "Keyboard macro aborted.")))))


(defun calc-kbd-push (arg)
  (interactive "P")
  (calc-wrapper
   (let* ((defs (and arg (> (prefix-numeric-value arg) 0)))
	  (var-q0 (and (boundp 'var-q0) var-q0))

	   (let ((calc-kbd-push-level 0))
	     (execute-kbd-macro (substring body 0 -2))))
       (let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
	 (message "Saving modes; type Z' to restore")
	 (recursive-edit))))))
(setq calc-kbd-push-level 0)

(defun calc-kbd-pop ()
  (interactive)
  (if (> calc-kbd-push-level 0)
      (progn

(defun calcFunc-istrue (a)
  (if (math-is-true a)
      1
    0))




;;;; User-programmability.

(defmacro math-while (head &rest body)
  (let ((body (cons 'while (cons head body))))
    (if (math-body-refers-to body 'math-break)
	(cons 'catch (cons '(quote math-break) (list body)))
      body)))


(defmacro math-for (head &rest body)
  (let ((body (if head
		  (math-handle-for head body)
		(cons 'while (cons t body)))))
    (if (math-body-refers-to body 'math-break)
	(cons 'catch (cons '(quote math-break) (list body)))
      body)))

(defun math-handle-for (head body)
  (let* ((var (nth 0 (car head)))
	 (init (nth 1 (car head)))
	 (limit (nth 2 (car head)))

							   '+
							 'math-add)
						       var
						       save-step)))))))))))


(defmacro math-foreach (head &rest body)
  (let ((body (math-handle-foreach head body)))
    (if (math-body-refers-to body 'math-break)
	(cons 'catch (cons '(quote math-break) (list body)))
      body)))


(defun math-handle-foreach (head body)
  (let ((var (nth 0 (car head)))
	(data (nth 1 (car head)))
	(body (if (cdr head)

41271:fcd507927105

;;; calc-prog.el --- user programmability functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainer: Colin Walters <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor

;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; Commentary:

;;; Code:


;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

(defun calc-timing (n)
  (interactive "P")
  (calc-wrapper
   (calc-change-mode 'calc-timing n nil t)
   (message (if calc-timing
		"Reporting timing of slow commands in Trail"
	      "Not reporting timing of commands"))))

(defun calc-pass-errors ()
  (interactive)
  ;; The following two cases are for the new, optimizing byte compiler
  ;; or the standard 18.57 byte compiler, respectively.

	(or (memq (car-safe (car-safe place)) '(error xxxerror))
	    (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27)))
	(or (memq (car (car place)) '(error xxxerror))
	    (error "foo"))
	(setcar (car place) 'xxxerror))
    (error (error "The calc-do function has been modified; unable to patch"))))

(defun calc-user-define ()
  (interactive)
  (message "Define user key: z-")
  (let ((key (read-char)))

  (calc-wrapper
   (let ((cond (calc-top-n 1)))
     (calc-pop-stack 1)
     (if (math-is-true cond)
	 (if defining-kbd-macro
	     (message "If true.."))
       (if defining-kbd-macro
	   (message "Condition is false; skipping to Z: or Z] ..."))
       (calc-kbd-skip-to-else-if t)))))

(defun calc-kbd-else-if ()

    (and (not executing-kbd-macro)
	 (= rpt-count 1000000)
	 (null parts)
	 (null counter)
	 (progn
	   (message "Warning: Infinite loop! Not executing")
	   (setq rpt-count 0)))
    (or (not initial) dir
	(setq dir (math-compare final initial)))
    (calc-wrapper
     (while (> rpt-count 0)

  (interactive)
  (calc-wrapper
   (let ((cond (calc-top-n 1)))
     (calc-pop-stack 1)
     (if (math-is-true cond)
	 (error "Keyboard macro aborted")))))


(defvar calc-kbd-push-level 0)
(defun calc-kbd-push (arg)
  (interactive "P")
  (calc-wrapper
   (let* ((defs (and arg (> (prefix-numeric-value arg) 0)))
	  (var-q0 (and (boundp 'var-q0) var-q0))

	   (let ((calc-kbd-push-level 0))
	     (execute-kbd-macro (substring body 0 -2))))
       (let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
	 (message "Saving modes; type Z' to restore")
	 (recursive-edit))))))

(defun calc-kbd-pop ()
  (interactive)
  (if (> calc-kbd-push-level 0)
      (progn

(defun calcFunc-istrue (a)
  (if (math-is-true a)
      1
    0))



;;;; User-programmability.

(defmacro math-while (head &rest body)
  (let ((body (cons 'while (cons head body))))
    (if (math-body-refers-to body 'math-break)
	(cons 'catch (cons '(quote math-break) (list body)))
      body)))
;; (put 'math-while 'lisp-indent-hook 1)

(defmacro math-for (head &rest body)
  (let ((body (if head
		  (math-handle-for head body)
		(cons 'while (cons t body)))))
    (if (math-body-refers-to body 'math-break)
	(cons 'catch (cons '(quote math-break) (list body)))
      body)))
;; (put 'math-for 'lisp-indent-hook 1)

(defun math-handle-for (head body)
  (let* ((var (nth 0 (car head)))
	 (init (nth 1 (car head)))
	 (limit (nth 2 (car head)))

							   '+
							 'math-add)
						       var
						       save-step)))))))))))

(defmacro math-foreach (head &rest body)
  (let ((body (math-handle-foreach head body)))
    (if (math-body-refers-to body 'math-break)
	(cons 'catch (cons '(quote math-break) (list body)))
      body)))
;; (put 'math-foreach 'lisp-indent-hook 1)

(defun math-handle-foreach (head body)
  (let ((var (nth 0 (car head)))
	(data (nth 1 (car head)))
	(body (if (cdr head)