comparison lisp/calc/calc-aent.el @ 41039:e65205f993f3

Style cleanup; don't put closing parens on their own line, add "foo.el ends here" to each file, and update copyright date.

41038:a882905d8a96

      (if (eq last-command-char 10)
	  (insert shortbuf)
	(setq kill-ring (cons shortbuf kill-ring))
	(if (> (length kill-ring) kill-ring-max)
	    (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
	(setq kill-ring-yank-pointer kill-ring))))
)

(defun calc-do-calc-eval (str separator args)
  (calc-check-defines)
  (catch 'calc-error
    (save-excursion

		  (t (while res
		       (setq buf (concat buf
					 (and buf (or separator ", "))
					 (math-format-value (car res) 1000))
			     res (cdr res)))
		     buf))))))))
)

(defun calc-eval-error (msg)
  (if (and (boundp 'calc-eval-error)
	   calc-eval-error)
      (if (eq calc-eval-error 'string)
	  (nth 1 msg)
	(error "%s" (nth 1 msg)))
    msg)
)


;;;; Reading an expression in algebraic form.

(defun calc-auto-algebraic-entry (&optional prefix)
  (interactive "P")
  (calc-algebraic-entry prefix t)
)

(defun calc-algebraic-entry (&optional prefix auto)
  (interactive "P")
  (calc-wrapper
   (let ((calc-language (if prefix nil calc-language))
	 (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
     (calc-alg-entry (and auto (char-to-string last-command-char)))))
)

(defun calc-alg-entry (&optional initial prompt)
  (let* ((sel-mode nil)
	 (calc-dollar-values (mapcar 'calc-get-stack-element
				     (nthcdr calc-stack-top calc-stack)))

					  "")
				     (list (car nvals)))
	  (setq alg-exp (cdr alg-exp)
		nvals (cdr nvals)
		calc-dollar-used 0)))
      (calc-handle-whys)))
)

(defun calc-do-alg-entry (&optional initial prompt no-normalize)
  (let* ((calc-buffer (current-buffer))
	 (blink-paren-function 'calcAlg-blink-matching-open)
	 (alg-exp 'error))

	  (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
	      (setq alg-exp nil)))
      (setq calc-aborted-prefix "alg'")
      (or no-normalize
	  (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
      alg-exp))
)

(defun calcAlg-plus-minus ()
  (interactive)
  (if (calc-minibuffer-contains ".* \\'")
      (insert "+/- ")
    (insert " +/- "))
)

(defun calcAlg-mod ()
  (interactive)
  (if (not (calc-minibuffer-contains ".* \\'"))
      (insert " "))
  (if (calc-minibuffer-contains ".* mod +\\'")
      (if calc-previous-modulo
	  (insert (math-format-flat-expr calc-previous-modulo 0))
	(beep))
    (insert "mod "))
)

(defun calcAlg-previous ()
  (interactive)
  (if (calc-minibuffer-contains "\\`\\'")
      (if calc-previous-alg-entry
	  (insert calc-previous-alg-entry)
	(beep))
    (insert "'"))
)

(defun calcAlg-equals ()
  (interactive)
  (unwind-protect
      (calcAlg-enter)
    (if (consp alg-exp)
	(progn (setq prefix-arg (length alg-exp))
	       (calc-unread-command ?=))))
)

(defun calcAlg-escape ()
  (interactive)
  (calc-unread-command)
  (save-excursion
    (calc-select-buffer)
    (use-local-map calc-mode-map))
  (calcAlg-enter)
)

(defun calcAlg-edit ()
  (interactive)
  (if (or (not calc-plain-entry)
	  (calc-minibuffer-contains
	   "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
      (insert "`")
    (setq alg-exp (minibuffer-contents))
    (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
    (exit-minibuffer))
)
(setq calc-plain-entry nil)

(defun calcAlg-enter ()
  (interactive)
  (let* ((str (minibuffer-contents))

	  (calc-clear-unread-commands))
      (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
			'((incomplete vec))
		      exp))
      (and (> (length str) 0) (setq calc-previous-alg-entry str))
      (exit-minibuffer)))
)

(defun calcAlg-blink-matching-open ()
  (let ((oldpos (point))
	(blinkpos nil))
    (save-excursion

		(aset (syntax-table) (char-after blinkpos)
		      (+ (logand saved 255)
			 (lsh (char-after (1- oldpos)) 8)))
		(blink-matching-open))
	    (aset (syntax-table) (char-after blinkpos) saved)))
      (blink-matching-open)))
)


(defun calc-alg-digit-entry ()
  (calc-alg-entry 
   (cond ((eq last-command-char ?e)
	  (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
	 ((eq last-command-char ?#) (format "%d#" calc-number-radix))
	 ((eq last-command-char ?_) "-")
	 ((eq last-command-char ?@) "0@ ")
	 (t (char-to-string last-command-char))))
)

(defun calcDigit-algebraic ()
  (interactive)
  (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
      (calcDigit-key)
    (setq calc-digit-value (minibuffer-contents))
    (exit-minibuffer))
)

(defun calcDigit-edit ()
  (interactive)
  (calc-unread-command)
  (setq calc-digit-value (minibuffer-contents))
  (exit-minibuffer)
)


;;; Algebraic expression parsing.   [Public]

(defun math-read-exprs (exp-str)

    (let ((val (catch 'syntax (math-read-expr-list))))
      (if (stringp val)
	  (list 'error exp-old-pos val)
	(if (equal exp-token 'end)
	    val
	  (list 'error exp-old-pos "Syntax error")))))
)

(defun math-read-expr-list ()
  (let* ((exp-keep-spaces nil)
	 (val (list (math-read-expr-level 0)))
	 (last val))
    (while (equal exp-data ",")
      (math-read-token)
      (let ((rest (list (math-read-expr-level 0))))
	(setcdr last rest)
	(setq last rest)))
    val)
)

(setq calc-user-parse-table nil)
(setq calc-last-main-parse-table nil)
(setq calc-last-lang-parse-table nil)
(setq calc-user-tokens nil)

						  (function (lambda (x y)
							      (> (length x)
								 (length y)))))
					    "\\|")
		calc-last-main-parse-table mtab
		calc-last-lang-parse-table ltab))))
)

(defun math-find-user-tokens (p)   ; uses "toks"
  (while p
    (cond ((and (stringp (car p))
		(or (> (length (car p)) 1) (equal (car p) "$")

				   calc-user-token-chars)))))))
	  ((consp (car p))
	   (math-find-user-tokens (nth 1 (car p)))
	   (or (eq (car (car p)) '\?)
	       (math-find-user-tokens (nth 2 (car p))))))
    (setq p (cdr p)))
)

(defun math-read-token ()
  (if (>= exp-pos (length exp-str))
      (setq exp-old-pos exp-pos
	    exp-token 'end

		 (setq ch ?\)))
	     (if (and (eq ch ?\&) (eq calc-language 'tex))
		 (setq ch ?\,))
	     (setq exp-token 'punc
		   exp-data (char-to-string ch)
		   exp-pos (1+ exp-pos))))))
)


(defun math-read-expr-level (exp-prec &optional exp-term)
  (let* ((x (math-read-factor)) (first t) op op2)
    (while (and (or (and calc-user-parse-table

		     (math-composite-inequalities x op))
		    (t (list (nth 1 op)
			     x
			     (math-read-expr-level (nth 3 op) exp-term))))
	    first nil))
    x)
)

(defun calc-check-user-syntax (&optional x prec)
  (let ((p calc-user-parse-table)
	(matches nil)
	match rule)

			      (setq exp-old-pos save-exp-old-pos
				    exp-token save-exp-token
				    exp-data save-exp-data
				    exp-pos save-exp-pos)))))))
      (setq p (cdr p)))
    (and p match))
)

(defun calc-match-user-syntax (p &optional term)
  (let ((matches nil)
	(save-exp-pos exp-pos)
	(save-exp-old-pos exp-old-pos)

	(setq exp-pos save-exp-pos
	      exp-old-pos save-exp-old-pos
	      exp-token save-exp-token
	      exp-data save-exp-data
	      matches "Failed"))
    matches)
)

(defconst math-alg-inequalities
  '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
		calcFunc-eq calcFunc-neq))

(defun math-remove-dashes (x)
  (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
      (math-remove-dashes
       (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
    x)
)

(defun math-restore-dashes (x)
  (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
      (math-restore-dashes
       (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
    x)
)

(defun math-read-if (cond op)
  (let ((then (math-read-expr-level 0)))
    (or (equal exp-data ":")
	(throw 'syntax "Expected ':'"))
    (math-read-token)
    (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))
)

(defun math-factor-after ()
  (let ((exp-pos exp-pos)
	exp-old-pos exp-token exp-data)
    (math-read-token)
    (or (memq exp-token '(number symbol dollar hash string))
	(and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
	     (assoc (concat "u" exp-data) math-expr-opers))
	(eq (nth 2 (assoc exp-data math-expr-opers)) -1)
	(assoc exp-data '(("(") ("[") ("{")))))
)

(defun math-read-factor ()
  (let (op)
    (cond ((eq exp-token 'number)
	   (let ((num (math-read-number exp-data)))

	   (calc-extensions)
	   (math-read-brackets nil "}"))
	  ((equal exp-data "<")
	   (calc-extensions)
	   (math-read-angle-brackets))
	  (t (throw 'syntax "Expected a number"))))
)

41039:e65205f993f3

      (if (eq last-command-char 10)
	  (insert shortbuf)
	(setq kill-ring (cons shortbuf kill-ring))
	(if (> (length kill-ring) kill-ring-max)
	    (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
	(setq kill-ring-yank-pointer kill-ring)))))

(defun calc-do-calc-eval (str separator args)
  (calc-check-defines)
  (catch 'calc-error
    (save-excursion

		  (t (while res
		       (setq buf (concat buf
					 (and buf (or separator ", "))
					 (math-format-value (car res) 1000))
			     res (cdr res)))
		     buf)))))))))

(defun calc-eval-error (msg)
  (if (and (boundp 'calc-eval-error)
	   calc-eval-error)
      (if (eq calc-eval-error 'string)
	  (nth 1 msg)
	(error "%s" (nth 1 msg)))
    msg))


;;;; Reading an expression in algebraic form.

(defun calc-auto-algebraic-entry (&optional prefix)
  (interactive "P")
  (calc-algebraic-entry prefix t))

(defun calc-algebraic-entry (&optional prefix auto)
  (interactive "P")
  (calc-wrapper
   (let ((calc-language (if prefix nil calc-language))
	 (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
     (calc-alg-entry (and auto (char-to-string last-command-char))))))

(defun calc-alg-entry (&optional initial prompt)
  (let* ((sel-mode nil)
	 (calc-dollar-values (mapcar 'calc-get-stack-element
				     (nthcdr calc-stack-top calc-stack)))

					  "")
				     (list (car nvals)))
	  (setq alg-exp (cdr alg-exp)
		nvals (cdr nvals)
		calc-dollar-used 0)))
      (calc-handle-whys))))

(defun calc-do-alg-entry (&optional initial prompt no-normalize)
  (let* ((calc-buffer (current-buffer))
	 (blink-paren-function 'calcAlg-blink-matching-open)
	 (alg-exp 'error))

	  (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
	      (setq alg-exp nil)))
      (setq calc-aborted-prefix "alg'")
      (or no-normalize
	  (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
      alg-exp)))

(defun calcAlg-plus-minus ()
  (interactive)
  (if (calc-minibuffer-contains ".* \\'")
      (insert "+/- ")
    (insert " +/- ")))

(defun calcAlg-mod ()
  (interactive)
  (if (not (calc-minibuffer-contains ".* \\'"))
      (insert " "))
  (if (calc-minibuffer-contains ".* mod +\\'")
      (if calc-previous-modulo
	  (insert (math-format-flat-expr calc-previous-modulo 0))
	(beep))
    (insert "mod ")))

(defun calcAlg-previous ()
  (interactive)
  (if (calc-minibuffer-contains "\\`\\'")
      (if calc-previous-alg-entry
	  (insert calc-previous-alg-entry)
	(beep))
    (insert "'")))

(defun calcAlg-equals ()
  (interactive)
  (unwind-protect
      (calcAlg-enter)
    (if (consp alg-exp)
	(progn (setq prefix-arg (length alg-exp))
	       (calc-unread-command ?=)))))

(defun calcAlg-escape ()
  (interactive)
  (calc-unread-command)
  (save-excursion
    (calc-select-buffer)
    (use-local-map calc-mode-map))
  (calcAlg-enter))

(defun calcAlg-edit ()
  (interactive)
  (if (or (not calc-plain-entry)
	  (calc-minibuffer-contains
	   "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
      (insert "`")
    (setq alg-exp (minibuffer-contents))
    (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
    (exit-minibuffer)))
(setq calc-plain-entry nil)

(defun calcAlg-enter ()
  (interactive)
  (let* ((str (minibuffer-contents))

	  (calc-clear-unread-commands))
      (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
			'((incomplete vec))
		      exp))
      (and (> (length str) 0) (setq calc-previous-alg-entry str))
      (exit-minibuffer))))

(defun calcAlg-blink-matching-open ()
  (let ((oldpos (point))
	(blinkpos nil))
    (save-excursion

		(aset (syntax-table) (char-after blinkpos)
		      (+ (logand saved 255)
			 (lsh (char-after (1- oldpos)) 8)))
		(blink-matching-open))
	    (aset (syntax-table) (char-after blinkpos) saved)))
      (blink-matching-open))))


(defun calc-alg-digit-entry ()
  (calc-alg-entry 
   (cond ((eq last-command-char ?e)
	  (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
	 ((eq last-command-char ?#) (format "%d#" calc-number-radix))
	 ((eq last-command-char ?_) "-")
	 ((eq last-command-char ?@) "0@ ")
	 (t (char-to-string last-command-char)))))

(defun calcDigit-algebraic ()
  (interactive)
  (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
      (calcDigit-key)
    (setq calc-digit-value (minibuffer-contents))
    (exit-minibuffer)))

(defun calcDigit-edit ()
  (interactive)
  (calc-unread-command)
  (setq calc-digit-value (minibuffer-contents))
  (exit-minibuffer))


;;; Algebraic expression parsing.   [Public]

(defun math-read-exprs (exp-str)

    (let ((val (catch 'syntax (math-read-expr-list))))
      (if (stringp val)
	  (list 'error exp-old-pos val)
	(if (equal exp-token 'end)
	    val
	  (list 'error exp-old-pos "Syntax error"))))))

(defun math-read-expr-list ()
  (let* ((exp-keep-spaces nil)
	 (val (list (math-read-expr-level 0)))
	 (last val))
    (while (equal exp-data ",")
      (math-read-token)
      (let ((rest (list (math-read-expr-level 0))))
	(setcdr last rest)
	(setq last rest)))
    val))

(setq calc-user-parse-table nil)
(setq calc-last-main-parse-table nil)
(setq calc-last-lang-parse-table nil)
(setq calc-user-tokens nil)

						  (function (lambda (x y)
							      (> (length x)
								 (length y)))))
					    "\\|")
		calc-last-main-parse-table mtab
		calc-last-lang-parse-table ltab)))))

(defun math-find-user-tokens (p)   ; uses "toks"
  (while p
    (cond ((and (stringp (car p))
		(or (> (length (car p)) 1) (equal (car p) "$")

				   calc-user-token-chars)))))))
	  ((consp (car p))
	   (math-find-user-tokens (nth 1 (car p)))
	   (or (eq (car (car p)) '\?)
	       (math-find-user-tokens (nth 2 (car p))))))
    (setq p (cdr p))))

(defun math-read-token ()
  (if (>= exp-pos (length exp-str))
      (setq exp-old-pos exp-pos
	    exp-token 'end

		 (setq ch ?\)))
	     (if (and (eq ch ?\&) (eq calc-language 'tex))
		 (setq ch ?\,))
	     (setq exp-token 'punc
		   exp-data (char-to-string ch)
		   exp-pos (1+ exp-pos)))))))


(defun math-read-expr-level (exp-prec &optional exp-term)
  (let* ((x (math-read-factor)) (first t) op op2)
    (while (and (or (and calc-user-parse-table

		     (math-composite-inequalities x op))
		    (t (list (nth 1 op)
			     x
			     (math-read-expr-level (nth 3 op) exp-term))))
	    first nil))
    x))

(defun calc-check-user-syntax (&optional x prec)
  (let ((p calc-user-parse-table)
	(matches nil)
	match rule)

			      (setq exp-old-pos save-exp-old-pos
				    exp-token save-exp-token
				    exp-data save-exp-data
				    exp-pos save-exp-pos)))))))
      (setq p (cdr p)))
    (and p match)))

(defun calc-match-user-syntax (p &optional term)
  (let ((matches nil)
	(save-exp-pos exp-pos)
	(save-exp-old-pos exp-old-pos)

	(setq exp-pos save-exp-pos
	      exp-old-pos save-exp-old-pos
	      exp-token save-exp-token
	      exp-data save-exp-data
	      matches "Failed"))
    matches))

(defconst math-alg-inequalities
  '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
		calcFunc-eq calcFunc-neq))

(defun math-remove-dashes (x)
  (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
      (math-remove-dashes
       (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
    x))

(defun math-restore-dashes (x)
  (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
      (math-restore-dashes
       (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
    x))

(defun math-read-if (cond op)
  (let ((then (math-read-expr-level 0)))
    (or (equal exp-data ":")
	(throw 'syntax "Expected ':'"))
    (math-read-token)
    (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))

(defun math-factor-after ()
  (let ((exp-pos exp-pos)
	exp-old-pos exp-token exp-data)
    (math-read-token)
    (or (memq exp-token '(number symbol dollar hash string))
	(and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
	     (assoc (concat "u" exp-data) math-expr-opers))
	(eq (nth 2 (assoc exp-data math-expr-opers)) -1)
	(assoc exp-data '(("(") ("[") ("{"))))))

(defun math-read-factor ()
  (let (op)
    (cond ((eq exp-token 'number)
	   (let ((num (math-read-number exp-data)))

	   (calc-extensions)
	   (math-read-brackets nil "}"))
	  ((equal exp-data "<")
	   (calc-extensions)
	   (math-read-angle-brackets))
	  (t (throw 'syntax "Expected a number")))))

;;; calc-aent.el ends here