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

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

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

revision 1.3 by eliz, Tue Nov 13 07:27:27 2001 UTC revision 1.4 by walters, Wed Nov 14 08:59:18 2001 UTC
# Line 99  Line 99 
99          (setq kill-ring (cons shortbuf kill-ring))          (setq kill-ring (cons shortbuf kill-ring))
100          (if (> (length kill-ring) kill-ring-max)          (if (> (length kill-ring) kill-ring-max)
101              (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))              (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
102          (setq kill-ring-yank-pointer kill-ring))))          (setq kill-ring-yank-pointer kill-ring)))))
 )  
103    
104  (defun calc-do-calc-eval (str separator args)  (defun calc-do-calc-eval (str separator args)
105    (calc-check-defines)    (calc-check-defines)
# Line 238  Line 237 
237                                           (and buf (or separator ", "))                                           (and buf (or separator ", "))
238                                           (math-format-value (car res) 1000))                                           (math-format-value (car res) 1000))
239                               res (cdr res)))                               res (cdr res)))
240                       buf))))))))                       buf)))))))))
 )  
241    
242  (defun calc-eval-error (msg)  (defun calc-eval-error (msg)
243    (if (and (boundp 'calc-eval-error)    (if (and (boundp 'calc-eval-error)
# Line 247  Line 245 
245        (if (eq calc-eval-error 'string)        (if (eq calc-eval-error 'string)
246            (nth 1 msg)            (nth 1 msg)
247          (error "%s" (nth 1 msg)))          (error "%s" (nth 1 msg)))
248      msg)      msg))
 )  
249    
250    
251  ;;;; Reading an expression in algebraic form.  ;;;; Reading an expression in algebraic form.
252    
253  (defun calc-auto-algebraic-entry (&optional prefix)  (defun calc-auto-algebraic-entry (&optional prefix)
254    (interactive "P")    (interactive "P")
255    (calc-algebraic-entry prefix t)    (calc-algebraic-entry prefix t))
 )  
256    
257  (defun calc-algebraic-entry (&optional prefix auto)  (defun calc-algebraic-entry (&optional prefix auto)
258    (interactive "P")    (interactive "P")
259    (calc-wrapper    (calc-wrapper
260     (let ((calc-language (if prefix nil calc-language))     (let ((calc-language (if prefix nil calc-language))
261           (math-expr-opers (if prefix math-standard-opers math-expr-opers)))           (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
262       (calc-alg-entry (and auto (char-to-string last-command-char)))))       (calc-alg-entry (and auto (char-to-string last-command-char))))))
 )  
263    
264  (defun calc-alg-entry (&optional initial prompt)  (defun calc-alg-entry (&optional initial prompt)
265    (let* ((sel-mode nil)    (let* ((sel-mode nil)
# Line 293  Line 288 
288            (setq alg-exp (cdr alg-exp)            (setq alg-exp (cdr alg-exp)
289                  nvals (cdr nvals)                  nvals (cdr nvals)
290                  calc-dollar-used 0)))                  calc-dollar-used 0)))
291        (calc-handle-whys)))        (calc-handle-whys))))
 )  
292    
293  (defun calc-do-alg-entry (&optional initial prompt no-normalize)  (defun calc-do-alg-entry (&optional initial prompt no-normalize)
294    (let* ((calc-buffer (current-buffer))    (let* ((calc-buffer (current-buffer))
# Line 332  Line 326 
326        (setq calc-aborted-prefix "alg'")        (setq calc-aborted-prefix "alg'")
327        (or no-normalize        (or no-normalize
328            (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))            (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
329        alg-exp))        alg-exp)))
 )  
330    
331  (defun calcAlg-plus-minus ()  (defun calcAlg-plus-minus ()
332    (interactive)    (interactive)
333    (if (calc-minibuffer-contains ".* \\'")    (if (calc-minibuffer-contains ".* \\'")
334        (insert "+/- ")        (insert "+/- ")
335      (insert " +/- "))      (insert " +/- ")))
 )  
336    
337  (defun calcAlg-mod ()  (defun calcAlg-mod ()
338    (interactive)    (interactive)
# Line 350  Line 342 
342        (if calc-previous-modulo        (if calc-previous-modulo
343            (insert (math-format-flat-expr calc-previous-modulo 0))            (insert (math-format-flat-expr calc-previous-modulo 0))
344          (beep))          (beep))
345      (insert "mod "))      (insert "mod ")))
 )  
346    
347  (defun calcAlg-previous ()  (defun calcAlg-previous ()
348    (interactive)    (interactive)
# Line 359  Line 350 
350        (if calc-previous-alg-entry        (if calc-previous-alg-entry
351            (insert calc-previous-alg-entry)            (insert calc-previous-alg-entry)
352          (beep))          (beep))
353      (insert "'"))      (insert "'")))
 )  
354    
355  (defun calcAlg-equals ()  (defun calcAlg-equals ()
356    (interactive)    (interactive)
# Line 368  Line 358 
358        (calcAlg-enter)        (calcAlg-enter)
359      (if (consp alg-exp)      (if (consp alg-exp)
360          (progn (setq prefix-arg (length alg-exp))          (progn (setq prefix-arg (length alg-exp))
361                 (calc-unread-command ?=))))                 (calc-unread-command ?=)))))
 )  
362    
363  (defun calcAlg-escape ()  (defun calcAlg-escape ()
364    (interactive)    (interactive)
# Line 377  Line 366 
366    (save-excursion    (save-excursion
367      (calc-select-buffer)      (calc-select-buffer)
368      (use-local-map calc-mode-map))      (use-local-map calc-mode-map))
369    (calcAlg-enter)    (calcAlg-enter))
 )  
370    
371  (defun calcAlg-edit ()  (defun calcAlg-edit ()
372    (interactive)    (interactive)
# Line 388  Line 376 
376        (insert "`")        (insert "`")
377      (setq alg-exp (minibuffer-contents))      (setq alg-exp (minibuffer-contents))
378      (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))      (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
379      (exit-minibuffer))      (exit-minibuffer)))
 )  
380  (setq calc-plain-entry nil)  (setq calc-plain-entry nil)
381    
382  (defun calcAlg-enter ()  (defun calcAlg-enter ()
# Line 411  Line 398 
398                          '((incomplete vec))                          '((incomplete vec))
399                        exp))                        exp))
400        (and (> (length str) 0) (setq calc-previous-alg-entry str))        (and (> (length str) 0) (setq calc-previous-alg-entry str))
401        (exit-minibuffer)))        (exit-minibuffer))))
 )  
402    
403  (defun calcAlg-blink-matching-open ()  (defun calcAlg-blink-matching-open ()
404    (let ((oldpos (point))    (let ((oldpos (point))
# Line 438  Line 424 
424                           (lsh (char-after (1- oldpos)) 8)))                           (lsh (char-after (1- oldpos)) 8)))
425                  (blink-matching-open))                  (blink-matching-open))
426              (aset (syntax-table) (char-after blinkpos) saved)))              (aset (syntax-table) (char-after blinkpos) saved)))
427        (blink-matching-open)))        (blink-matching-open))))
 )  
428    
429    
430  (defun calc-alg-digit-entry ()  (defun calc-alg-digit-entry ()
# Line 449  Line 434 
434           ((eq last-command-char ?#) (format "%d#" calc-number-radix))           ((eq last-command-char ?#) (format "%d#" calc-number-radix))
435           ((eq last-command-char ?_) "-")           ((eq last-command-char ?_) "-")
436           ((eq last-command-char ?@) "0@ ")           ((eq last-command-char ?@) "0@ ")
437           (t (char-to-string last-command-char))))           (t (char-to-string last-command-char)))))
 )  
438    
439  (defun calcDigit-algebraic ()  (defun calcDigit-algebraic ()
440    (interactive)    (interactive)
441    (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")    (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
442        (calcDigit-key)        (calcDigit-key)
443      (setq calc-digit-value (minibuffer-contents))      (setq calc-digit-value (minibuffer-contents))
444      (exit-minibuffer))      (exit-minibuffer)))
 )  
445    
446  (defun calcDigit-edit ()  (defun calcDigit-edit ()
447    (interactive)    (interactive)
448    (calc-unread-command)    (calc-unread-command)
449    (setq calc-digit-value (minibuffer-contents))    (setq calc-digit-value (minibuffer-contents))
450    (exit-minibuffer)    (exit-minibuffer))
 )  
451    
452    
453  ;;; Algebraic expression parsing.   [Public]  ;;; Algebraic expression parsing.   [Public]
# Line 487  Line 469 
469            (list 'error exp-old-pos val)            (list 'error exp-old-pos val)
470          (if (equal exp-token 'end)          (if (equal exp-token 'end)
471              val              val
472            (list 'error exp-old-pos "Syntax error")))))            (list 'error exp-old-pos "Syntax error"))))))
 )  
473    
474  (defun math-read-expr-list ()  (defun math-read-expr-list ()
475    (let* ((exp-keep-spaces nil)    (let* ((exp-keep-spaces nil)
# Line 499  Line 480 
480        (let ((rest (list (math-read-expr-level 0))))        (let ((rest (list (math-read-expr-level 0))))
481          (setcdr last rest)          (setcdr last rest)
482          (setq last rest)))          (setq last rest)))
483      val)      val))
 )  
484    
485  (setq calc-user-parse-table nil)  (setq calc-user-parse-table nil)
486  (setq calc-last-main-parse-table nil)  (setq calc-last-main-parse-table nil)
# Line 527  Line 507 
507                                                                   (length y)))))                                                                   (length y)))))
508                                              "\\|")                                              "\\|")
509                  calc-last-main-parse-table mtab                  calc-last-main-parse-table mtab
510                  calc-last-lang-parse-table ltab))))                  calc-last-lang-parse-table ltab)))))
 )  
511    
512  (defun math-find-user-tokens (p)   ; uses "toks"  (defun math-find-user-tokens (p)   ; uses "toks"
513    (while p    (while p
# Line 552  Line 531 
531             (math-find-user-tokens (nth 1 (car p)))             (math-find-user-tokens (nth 1 (car p)))
532             (or (eq (car (car p)) '\?)             (or (eq (car (car p)) '\?)
533                 (math-find-user-tokens (nth 2 (car p))))))                 (math-find-user-tokens (nth 2 (car p))))))
534      (setq p (cdr p)))      (setq p (cdr p))))
 )  
535    
536  (defun math-read-token ()  (defun math-read-token ()
537    (if (>= exp-pos (length exp-str))    (if (>= exp-pos (length exp-str))
# Line 721  Line 699 
699                   (setq ch ?\,))                   (setq ch ?\,))
700               (setq exp-token 'punc               (setq exp-token 'punc
701                     exp-data (char-to-string ch)                     exp-data (char-to-string ch)
702                     exp-pos (1+ exp-pos))))))                     exp-pos (1+ exp-pos)))))))
 )  
703    
704    
705  (defun math-read-expr-level (exp-prec &optional exp-term)  (defun math-read-expr-level (exp-prec &optional exp-term)
# Line 790  Line 767 
767                               x                               x
768                               (math-read-expr-level (nth 3 op) exp-term))))                               (math-read-expr-level (nth 3 op) exp-term))))
769              first nil))              first nil))
770      x)      x))
 )  
771    
772  (defun calc-check-user-syntax (&optional x prec)  (defun calc-check-user-syntax (&optional x prec)
773    (let ((p calc-user-parse-table)    (let ((p calc-user-parse-table)
# Line 877  Line 853 
853                                      exp-data save-exp-data                                      exp-data save-exp-data
854                                      exp-pos save-exp-pos)))))))                                      exp-pos save-exp-pos)))))))
855        (setq p (cdr p)))        (setq p (cdr p)))
856      (and p match))      (and p match)))
 )  
857    
858  (defun calc-match-user-syntax (p &optional term)  (defun calc-match-user-syntax (p &optional term)
859    (let ((matches nil)    (let ((matches nil)
# Line 937  Line 912 
912                exp-token save-exp-token                exp-token save-exp-token
913                exp-data save-exp-data                exp-data save-exp-data
914                matches "Failed"))                matches "Failed"))
915      matches)      matches))
 )  
916    
917  (defconst math-alg-inequalities  (defconst math-alg-inequalities
918    '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq    '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
# Line 948  Line 922 
922    (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)    (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
923        (math-remove-dashes        (math-remove-dashes
924         (concat (math-match-substring x 1) "#" (math-match-substring x 2)))         (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
925      x)      x))
 )  
926    
927  (defun math-restore-dashes (x)  (defun math-restore-dashes (x)
928    (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)    (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
929        (math-restore-dashes        (math-restore-dashes
930         (concat (math-match-substring x 1) "-" (math-match-substring x 2)))         (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
931      x)      x))
 )  
932    
933  (defun math-read-if (cond op)  (defun math-read-if (cond op)
934    (let ((then (math-read-expr-level 0)))    (let ((then (math-read-expr-level 0)))
935      (or (equal exp-data ":")      (or (equal exp-data ":")
936          (throw 'syntax "Expected ':'"))          (throw 'syntax "Expected ':'"))
937      (math-read-token)      (math-read-token)
938      (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))      (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
 )  
939    
940  (defun math-factor-after ()  (defun math-factor-after ()
941    (let ((exp-pos exp-pos)    (let ((exp-pos exp-pos)
# Line 974  Line 945 
945          (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))          (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
946               (assoc (concat "u" exp-data) math-expr-opers))               (assoc (concat "u" exp-data) math-expr-opers))
947          (eq (nth 2 (assoc exp-data math-expr-opers)) -1)          (eq (nth 2 (assoc exp-data math-expr-opers)) -1)
948          (assoc exp-data '(("(") ("[") ("{")))))          (assoc exp-data '(("(") ("[") ("{"))))))
 )  
949    
950  (defun math-read-factor ()  (defun math-read-factor ()
951    (let (op)    (let (op)
# Line 1157  Line 1127 
1127            ((equal exp-data "<")            ((equal exp-data "<")
1128             (calc-extensions)             (calc-extensions)
1129             (math-read-angle-brackets))             (math-read-angle-brackets))
1130            (t (throw 'syntax "Expected a number"))))            (t (throw 'syntax "Expected a number")))))
 )  
   
   
1131    
1132    ;;; calc-aent.el ends here

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