comparison lisp/calc/calc.el @ 41270:711f18abaf57

(calc-record-compilation-date): Remove. (calc-bug-address): Update. (calc-settings-file): Use `user-init-file'. 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.

41269:8b4a880d7759

;; Calculator for GNU Emacs, part I
;; 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.



;;; Calc is split into many files.  This file is the main entry point.
;;; This file includes autoload commands for various other basic Calc
;;; facilities.  The more advanced features are based in calc-ext, which
;;; in turn contains autoloads for the rest of the Calc files.  This

;;; of the prefixes "math", "Math", or "calc", with the exceptions of
;;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc",
;;; "report-calc-bug", and "defmath".  User-accessible variables begin
;;; with "var-".



(provide 'calc)
(require 'calc-macs)

(defun calc-record-compilation-date ()
  (calc-record-compilation-date-macro))
(calc-record-compilation-date)


;;; The "###autoload" comment will be used by Emacs version 19 for
;;; maintaining the loaddefs.el file automatically.

;;;###autoload
(defvar calc-info-filename "calc.info"
  "*File name in which to look for the Calculator's Info documentation.")

;;;###autoload
(defvar calc-settings-file "~/.emacs"
  "*File in which to record permanent settings; default is \"~/.emacs\".")

;;;###autoload
(defvar calc-autoload-directory nil
  "Name of directory from which additional \".elc\" files for Calc should be
loaded.  Should include a trailing \"/\".

;;;###autoload
(defvar calc-gnuplot-print-command "lp %s"
  "*Name of command for printing GNUPLOT output; %s = file name to print.")


;; Address of the author of Calc, for use by report-calc-bug.
(defvar calc-bug-address "[e-mail]")


;; If T, scan keymaps to find all DEL-like keys.
;; If NIL, only DEL itself is mapped to calc-pop.
(defvar calc-scan-for-dels t)



(defvar calc-extensions-loaded nil)



;;; IDEAS:
;;;
;;;   Fix rewrite mechanism to do less gratuitous rearrangement of terms.

  (mapcar (function (lambda (v) (or (boundp (car v)) (set (car v) (nth 1 v)))))
	  calc-mode-var-list)
  (mapcar (function (lambda (v) (or (boundp v) (set v nil))))
	  calc-local-var-list)

  (if (boundp 'calc-mode-map)
      nil
    (setq calc-mode-map (make-keymap))
    (suppress-keymap calc-mode-map t)
    (define-key calc-mode-map "+" 'calc-plus)
    (define-key calc-mode-map "-" 'calc-minus)
    (define-key calc-mode-map "*" 'calc-times)

 ("calc-misc" another-calc calc-big-or-small calc-dispatch-help
calc-help calc-info calc-info-summary calc-inv calc-last-args-stub
calc-missing-key calc-mod calc-other-window calc-over calc-percent
calc-pop-above calc-power calc-roll-down calc-roll-up
calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
report-calc-bug)

))
)

(calc-init-base)


;;;###autoload (global-set-key "\e#" 'calc-dispatch)

;;;###autoload
(defun calc-dispatch (&optional arg)
  "Invoke the GNU Emacs Calculator.  See calc-dispatch-help for details."
  (interactive "P")
  (sit-for echo-keystrokes)
  (condition-case err   ; look for other keys bound to calc-dispatch
      (let ((keys (this-command-keys)))
	(or (not (stringp keys))

		   (define-key calc-dispatch-map (substring keys 0 1) nil))
	      (define-key calc-dispatch-map keys 'calc-same-interface))))
    (error nil))
  (calc-do-dispatch arg))

(defun calc-do-dispatch (arg)
  (let ((key (calc-read-key-sequence
	      (if calc-dispatch-help
		  "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more"
		(format "%s  (Type ? for a list of Calc options)"

    (if key
	(progn
	  (or (commandp key) (calc-extensions))
	  (call-interactively key))
      (beep))))
(setq calc-dispatch-help nil)

(defun calc-read-key-sequence (prompt map)
  (let ((prompt2 (format "%s " (key-description (this-command-keys))))
	(glob (current-global-map))
	(loc (current-local-map)))

					 calc-stack)
				   (setq calc-stack (list (list 'top-of-stack
								1 nil))))))
  (setq calc-stack-top (- (length calc-stack) calc-stack-top -1))
  (or calc-loaded-settings-file
      (string-match "\\.emacs" calc-settings-file)
      (progn
	(setq calc-loaded-settings-file t)
	(load calc-settings-file t)))   ; t = missing-ok
  (if (and (eq window-system 'x) (boundp 'mouse-map))

	(eval (cons 'progn calc-defs))
	(setq calc-defs nil)
	(calc-set-mode-line)))
  (calc-check-defines))

(defun calc-check-defines ()
  (if (symbol-plist 'calc-define)
      (let ((plist (copy-sequence (symbol-plist 'calc-define))))
	(while (and plist (null (nth 1 plist)))
	  (setq plist (cdr (cdr plist))))

		(eval (nth 1 plist))
		(setq plist (cdr (cdr plist))))
	      ;; See if this has added any more calc-define properties.
	      (calc-check-defines))
	  (setplist 'calc-define nil)))))
(setq calc-check-defines 'calc-check-defines)  ; suitable for run-hooks

(defun calc-trail-mode (&optional buf)
  "Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
obtained by the GNU Emacs Calculator.

      (progn
	(make-local-variable 'calc-main-buffer)
	(setq calc-main-buffer buf)))
  (if (= (buffer-size) 0)
      (let ((buffer-read-only nil))
	(insert "Emacs Calculator v" calc-version " by Dave Gillespie, "
		"installed " calc-installed-date "\n")))
  (run-hooks 'calc-trail-mode-hook))

(defun calc-create-buffer ()
  (set-buffer (get-buffer-create "*Calculator*"))
  (or (eq major-mode 'calc-mode)

	(save-excursion
	  (set-buffer (calc-trail-buffer))
	  (and calc-display-trail
	       (= (window-width) (frame-width))
	       (calc-trail-display 1 t)))
	(message "Welcome to the GNU Emacs Calculator!  Press `?' or `h' for help, `q' to quit.")
	(run-hooks 'calc-start-hook)
	(and (windowp full-display)
	     (window-point full-display)
	     (select-window full-display))
	(calc-check-defines)

	(MacEdit-cancel-edit)
      (if (and (interactive-p)
	       calc-embedded-info
	       (eq (current-buffer) (aref calc-embedded-info 0)))
	  (calc-embedded nil)
	(or (eq major-mode 'calc-mode)
	    (calc-create-buffer))
	(run-hooks 'calc-end-hook)
	(setq calc-undo-list nil calc-redo-list nil)
	(mapcar (function (lambda (v) (set-default v (symbol-value v))))
		calc-local-var-list)
	(let ((buf (current-buffer))

  (interactive)
  (calc-extensions)
  (calc-do-keypad t (interactive-p)))


;;; Note that modifications to this function may break calc-pass-errors.
(defun calc-do (do-body &optional do-slow)
  (calc-check-defines)
  (let* ((calc-command-flags nil)
	 (calc-start-time (and calc-timing (not calc-start-time)

		  (calc-embedded-select-buffer)
		(calc-select-buffer))
	      (and (eq calc-algebraic-mode 'total)
		   (calc-extensions)
		   (use-local-map calc-alg-map))
	      (and do-slow calc-display-working-message
		   (progn
		     (message "Working...")
		     (calc-set-command-flag 'clear-message)))
	      (funcall do-body)
	      (setq calc-aborted-prefix nil)
	      (and (memq 'renum-stack calc-command-flags)
		   (calc-renumber-stack))
	      (and (memq 'clear-message calc-command-flags)
		   (message "")))
	  (error
	   (if (and (eq (car err) 'error)
		    (stringp (nth 1 err))
		    (string-match "max-specpdl-size\\|max-lisp-eval-depth"
				  (nth 1 err)))
	       (error "Computation got stuck or ran too long.  Type `M' to increase the limit.")
	     (setq calc-aborted-prefix nil)
	     (signal (car err) (cdr err)))))
      (setq calc-old-aborted-prefix calc-aborted-prefix)
      (and calc-aborted-prefix
	   (calc-record "<Aborted>" calc-aborted-prefix))
      (and calc-start-time
	   (let* ((calc-internal-prec 12)
		  (calc-date-format nil)
		  (end-time (current-time-string))
		  (time (if (equal calc-start-time end-time)

		 (move-to-column calc-final-point-column))
	     (save-excursion
	       (calc-select-buffer)
	       (goto-line calc-final-point-line)
	       (move-to-column calc-final-point-column))))
      (or (memq 'keep-flags calc-command-flags)
	  (save-excursion
	    (calc-select-buffer)
	    (setq calc-inverse-flag nil
		  calc-hyperbolic-flag nil
		  calc-keep-args-flag nil)))
      (and (memq 'do-edit calc-command-flags)
	   (switch-to-buffer (get-buffer-create "*Calc Edit*")))
      (calc-set-mode-line)
      (and calc-embedded-info
	   (calc-embedded-finish-command))))
  (identity nil))  ; allow a GC after timing is done

(setq calc-aborted-prefix nil)
(setq calc-start-time nil)

(defun calc-set-command-flag (f)
  (if (not (memq f calc-command-flags))
      (setq calc-command-flags (cons f calc-command-flags))))

(defun calc-select-buffer ()
  (or (eq major-mode 'calc-mode)
      (if calc-main-buffer
	  (set-buffer calc-main-buffer)

     ( "&&&"   calcFunc-pand  80  81 )
     ( "|||"   calcFunc-por   75  76 )
     ( ":="    calcFunc-assign 51 50 )
     ( "::"    calcFunc-condition 45 46 )
     ( "=>"    calcFunc-evalto 40 41 )
     ( "=>"    calcFunc-evalto 40 -1 )
))
(setq math-expr-opers math-standard-opers)


;;;###autoload
(defun calc-grab-region (top bot arg)
  "Parse the region as a vector of numbers and push it on the Calculator stack."
  (interactive "r\nP")

41270:711f18abaf57

;;; calc.el --- 

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

;; Author: David Gillespie <[e-mail]>
;; Maintainer: Colin Walters <[e-mail]>
;; Keywords: convenience, extensions

;; 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:

;;; Calc is split into many files.  This file is the main entry point.
;;; This file includes autoload commands for various other basic Calc
;;; facilities.  The more advanced features are based in calc-ext, which
;;; in turn contains autoloads for the rest of the Calc files.  This

;;; of the prefixes "math", "Math", or "calc", with the exceptions of
;;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc",
;;; "report-calc-bug", and "defmath".  User-accessible variables begin
;;; with "var-".

;;; Code:


(provide 'calc)
(require 'calc-macs)

;;; The "###autoload" comment will be used by Emacs version 19 for
;;; maintaining the loaddefs.el file automatically.

;;;###autoload
(defvar calc-info-filename "calc.info"
  "*File name in which to look for the Calculator's Info documentation.")

;;;###autoload
(defvar calc-settings-file user-init-file
  "*File in which to record permanent settings; default is `user-init-file'.")

;;;###autoload
(defvar calc-autoload-directory nil
  "Name of directory from which additional \".elc\" files for Calc should be
loaded.  Should include a trailing \"/\".

;;;###autoload
(defvar calc-gnuplot-print-command "lp %s"
  "*Name of command for printing GNUPLOT output; %s = file name to print.")

;; Address of the author of Calc, for use by report-calc-bug.
(defvar calc-bug-address "[e-mail]")

;; If T, scan keymaps to find all DEL-like keys.
;; If NIL, only DEL itself is mapped to calc-pop.
(defvar calc-scan-for-dels t)



(defvar calc-extensions-loaded nil)


;;; IDEAS:
;;;
;;;   Fix rewrite mechanism to do less gratuitous rearrangement of terms.

  (mapcar (function (lambda (v) (or (boundp (car v)) (set (car v) (nth 1 v)))))
	  calc-mode-var-list)
  (mapcar (function (lambda (v) (or (boundp v) (set v nil))))
	  calc-local-var-list)

  (unless (boundp 'calc-mode-map)
    (setq calc-mode-map (make-keymap))
    (suppress-keymap calc-mode-map t)
    (define-key calc-mode-map "+" 'calc-plus)
    (define-key calc-mode-map "-" 'calc-minus)
    (define-key calc-mode-map "*" 'calc-times)

 ("calc-misc" another-calc calc-big-or-small calc-dispatch-help
calc-help calc-info calc-info-summary calc-inv calc-last-args-stub
calc-missing-key calc-mod calc-other-window calc-over calc-percent
calc-pop-above calc-power calc-roll-down calc-roll-up
calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
report-calc-bug))))

(calc-init-base)


;;;###autoload (global-set-key "\e#" 'calc-dispatch)

;;;###autoload
(defun calc-dispatch (&optional arg)
  "Invoke the GNU Emacs Calculator.  See `calc-dispatch-help' for details."
  (interactive "P")
  (sit-for echo-keystrokes)
  (condition-case err   ; look for other keys bound to calc-dispatch
      (let ((keys (this-command-keys)))
	(or (not (stringp keys))

		   (define-key calc-dispatch-map (substring keys 0 1) nil))
	      (define-key calc-dispatch-map keys 'calc-same-interface))))
    (error nil))
  (calc-do-dispatch arg))

(defvar calc-dispatch-help nil)
(defun calc-do-dispatch (arg)
  (let ((key (calc-read-key-sequence
	      (if calc-dispatch-help
		  "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more"
		(format "%s  (Type ? for a list of Calc options)"

    (if key
	(progn
	  (or (commandp key) (calc-extensions))
	  (call-interactively key))
      (beep))))

(defun calc-read-key-sequence (prompt map)
  (let ((prompt2 (format "%s " (key-description (this-command-keys))))
	(glob (current-global-map))
	(loc (current-local-map)))

					 calc-stack)
				   (setq calc-stack (list (list 'top-of-stack
								1 nil))))))
  (setq calc-stack-top (- (length calc-stack) calc-stack-top -1))
  (or calc-loaded-settings-file
      (null calc-settings-file)
      (string-match "\\.emacs" calc-settings-file)
      (progn
	(setq calc-loaded-settings-file t)
	(load calc-settings-file t)))   ; t = missing-ok
  (if (and (eq window-system 'x) (boundp 'mouse-map))

	(eval (cons 'progn calc-defs))
	(setq calc-defs nil)
	(calc-set-mode-line)))
  (calc-check-defines))

(defvar calc-check-defines 'calc-check-defines)  ; suitable for run-hooks
(defun calc-check-defines ()
  (if (symbol-plist 'calc-define)
      (let ((plist (copy-sequence (symbol-plist 'calc-define))))
	(while (and plist (null (nth 1 plist)))
	  (setq plist (cdr (cdr plist))))

		(eval (nth 1 plist))
		(setq plist (cdr (cdr plist))))
	      ;; See if this has added any more calc-define properties.
	      (calc-check-defines))
	  (setplist 'calc-define nil)))))

(defun calc-trail-mode (&optional buf)
  "Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
obtained by the GNU Emacs Calculator.

      (progn
	(make-local-variable 'calc-main-buffer)
	(setq calc-main-buffer buf)))
  (if (= (buffer-size) 0)
      (let ((buffer-read-only nil))
	(insert "Emacs Calculator v" calc-version " by Dave Gillespie\n")))
  (run-hooks 'calc-trail-mode-hook))

(defun calc-create-buffer ()
  (set-buffer (get-buffer-create "*Calculator*"))
  (or (eq major-mode 'calc-mode)

	(save-excursion
	  (set-buffer (calc-trail-buffer))
	  (and calc-display-trail
	       (= (window-width) (frame-width))
	       (calc-trail-display 1 t)))
	(message "Welcome to the GNU Emacs Calculator!  Press `?' or `h' for help, `q' to quit")
	(run-hooks 'calc-start-hook)
	(and (windowp full-display)
	     (window-point full-display)
	     (select-window full-display))
	(calc-check-defines)

	(MacEdit-cancel-edit)
      (if (and (interactive-p)
	       calc-embedded-info
	       (eq (current-buffer) (aref calc-embedded-info 0)))
	  (calc-embedded nil)
	(unless (eq major-mode 'calc-mode)
	  (calc-create-buffer))
	(run-hooks 'calc-end-hook)
	(setq calc-undo-list nil calc-redo-list nil)
	(mapcar (function (lambda (v) (set-default v (symbol-value v))))
		calc-local-var-list)
	(let ((buf (current-buffer))

  (interactive)
  (calc-extensions)
  (calc-do-keypad t (interactive-p)))


(defvar calc-aborted-prefix nil)
(defvar calc-start-time nil)
;;; Note that modifications to this function may break calc-pass-errors.
(defun calc-do (do-body &optional do-slow)
  (calc-check-defines)
  (let* ((calc-command-flags nil)
	 (calc-start-time (and calc-timing (not calc-start-time)

		  (calc-embedded-select-buffer)
		(calc-select-buffer))
	      (and (eq calc-algebraic-mode 'total)
		   (calc-extensions)
		   (use-local-map calc-alg-map))
	      (when (and do-slow calc-display-working-message)
		(message "Working...")
		(calc-set-command-flag 'clear-message))
	      (funcall do-body)
	      (setq calc-aborted-prefix nil)
	      (when (memq 'renum-stack calc-command-flags)
		(calc-renumber-stack))
	      (when (memq 'clear-message calc-command-flags)
		(message "")))
	  (error
	   (if (and (eq (car err) 'error)
		    (stringp (nth 1 err))
		    (string-match "max-specpdl-size\\|max-lisp-eval-depth"
				  (nth 1 err)))
	       (error "Computation got stuck or ran too long.  Type `M' to increase the limit")
	     (setq calc-aborted-prefix nil)
	     (signal (car err) (cdr err)))))
      (setq calc-old-aborted-prefix calc-aborted-prefix)
      (when calc-aborted-prefix
	(calc-record "<Aborted>" calc-aborted-prefix))
      (and calc-start-time
	   (let* ((calc-internal-prec 12)
		  (calc-date-format nil)
		  (end-time (current-time-string))
		  (time (if (equal calc-start-time end-time)

		 (move-to-column calc-final-point-column))
	     (save-excursion
	       (calc-select-buffer)
	       (goto-line calc-final-point-line)
	       (move-to-column calc-final-point-column))))
      (unless (memq 'keep-flags calc-command-flags)
	(save-excursion
	  (calc-select-buffer)
	  (setq calc-inverse-flag nil
		calc-hyperbolic-flag nil
		calc-keep-args-flag nil)))
      (when (memq 'do-edit calc-command-flags)
	(switch-to-buffer (get-buffer-create "*Calc Edit*")))
      (calc-set-mode-line)
      (when calc-embedded-info
	(calc-embedded-finish-command))))
  (identity nil))  ; allow a GC after timing is done


(defun calc-set-command-flag (f)
  (unless (memq f calc-command-flags)
    (setq calc-command-flags (cons f calc-command-flags))))

(defun calc-select-buffer ()
  (or (eq major-mode 'calc-mode)
      (if calc-main-buffer
	  (set-buffer calc-main-buffer)

     ( "&&&"   calcFunc-pand  80  81 )
     ( "|||"   calcFunc-por   75  76 )
     ( ":="    calcFunc-assign 51 50 )
     ( "::"    calcFunc-condition 45 46 )
     ( "=>"    calcFunc-evalto 40 41 )
     ( "=>"    calcFunc-evalto 40 -1 )))
(defvar math-expr-opers math-standard-opers)

;;;###autoload
(defun calc-grab-region (top bot arg)
  "Parse the region as a vector of numbers and push it on the Calculator stack."
  (interactive "r\nP")