/[emacs]/emacs/lisp/calc/calccomp.el
ViewVC logotype

Diff of /emacs/lisp/calc/calccomp.el

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

revision 1.8 by jpb, Tue Nov 30 17:31:45 2004 UTC revision 1.9 by jpb, Mon Jan 31 06:30:37 2005 UTC
# Line 79  Line 79 
79    
80    
81  (defun math-compose-expr (a prec)  (defun math-compose-expr (a prec)
82    (let ((math-compose-level (1+ math-compose-level)))    (let ((math-compose-level (1+ math-compose-level))
83            spfn)
84      (cond      (cond
85       ((or (and (eq a math-comp-selected) a)       ((or (and (eq a math-comp-selected) a)
86            (and math-comp-tagged            (and math-comp-tagged
# Line 89  Line 90 
90          (list 'tag a (math-compose-expr a prec))))          (list 'tag a (math-compose-expr a prec))))
91       ((and (not (consp a)) (not (integerp a)))       ((and (not (consp a)) (not (integerp a)))
92        (concat "'" (prin1-to-string a)))        (concat "'" (prin1-to-string a)))
93         ((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
94          (setq spfn (cdr spfn))
95          (funcall (car spfn) a spfn))
96       ((math-scalarp a)       ((math-scalarp a)
97        (if (or (eq (car-safe a) 'frac)        (if (or (eq (car-safe a) 'frac)
98                (and (nth 1 calc-frac-format) (Math-integerp a)))                (and (nth 1 calc-frac-format) (Math-integerp a)))
99            (if (memq calc-language '(tex eqn math maple c fortran pascal))            (if (memq calc-language '(tex latex eqn math maple c fortran pascal))
100                (let ((aa (math-adjust-fraction a))                (let ((aa (math-adjust-fraction a))
101                      (calc-frac-format nil))                      (calc-frac-format nil))
102                  (math-compose-expr (list '/                  (math-compose-expr (list '/
# Line 265  Line 269 
269                        (append '(horiz "\\matrix{ ")                        (append '(horiz "\\matrix{ ")
270                                (math-compose-tex-matrix (cdr a))                                (math-compose-tex-matrix (cdr a))
271                                '(" }"))                                '(" }"))
272                      (if (and (eq calc-language 'eqn)                      (if (and (eq calc-language 'latex)
273                               (math-matrixp a))                               (math-matrixp a))
274                          (append '(horiz "matrix { ")                          (if (memq calc-language-option '(-2 0 2))
275                                  (math-compose-eqn-matrix                              (append '(vleft 0 "\\begin{pmatrix}")
276                                   (cdr (math-transpose a)))                                      (math-compose-tex-matrix (cdr a))
277                                  '("}"))                                      '("\\end{pmatrix}"))
278                        (if (and (eq calc-language 'maple)                            (append '(horiz "\\begin{pmatrix} ")
279                                 (math-matrixp a))                                    (math-compose-tex-matrix (cdr a))
280                            (list 'horiz                                    '(" \\end{pmatrix}")))
281                                  "matrix("                        (if (and (eq calc-language 'eqn)
282                                  math-comp-left-bracket                                 (math-matrixp a))
283                                  (math-compose-vector (cdr a)                            (append '(horiz "matrix { ")
284                                      (math-compose-eqn-matrix
285                                       (cdr (math-transpose a)))
286                                      '("}"))
287                            (if (and (eq calc-language 'maple)
288                                     (math-matrixp a))
289                                (list 'horiz
290                                      "matrix("
291                                      math-comp-left-bracket
292                                      (math-compose-vector (cdr a)
293                                                           (concat math-comp-comma " ")
294                                                           math-comp-vector-prec)
295                                      math-comp-right-bracket
296                                      ")")
297                              (list 'horiz
298                                    math-comp-left-bracket
299                                    (math-compose-vector (cdr a)
300                                                       (concat math-comp-comma " ")                                                       (concat math-comp-comma " ")
301                                                       math-comp-vector-prec)                                                       math-comp-vector-prec)
302                                  math-comp-right-bracket                                  math-comp-right-bracket)))))
                                 ")")  
                         (list 'horiz  
                               math-comp-left-bracket  
                               (math-compose-vector (cdr a)  
                                                    (concat math-comp-comma " ")  
                                                    math-comp-vector-prec)  
                               math-comp-right-bracket))))  
303                  (list 'horiz                  (list 'horiz
304                        math-comp-left-bracket                        math-comp-left-bracket
305                        (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))                        (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
306                                             (concat math-comp-comma " ")                                             (concat math-comp-comma " ")
307                                             math-comp-vector-prec)                                             math-comp-vector-prec)
308                        math-comp-comma (if (eq calc-language 'tex) " \\ldots" " ...")                        math-comp-comma (if (memq calc-language '(tex latex))
309                                              " \\ldots" " ...")
310                        math-comp-comma " "                        math-comp-comma " "
311                        (list 'break math-compose-level)                        (list 'break math-compose-level)
312                        (math-compose-expr (nth (1- (length a)) a)                        (math-compose-expr (nth (1- (length a)) a)
# Line 326  Line 340 
340        (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))        (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
341          (if v          (if v
342              (symbol-name (car v))              (symbol-name (car v))
343            (if (and (eq calc-language 'tex)            (if (and (memq calc-language '(tex latex))
344                     calc-language-option                     calc-language-option
345                     (not (= calc-language-option 0))                     (not (= calc-language-option 0))
346                     (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"                     (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
347                                   (symbol-name (nth 1 a))))                                   (symbol-name (nth 1 a))))
348                (format "\\hbox{%s}" (symbol-name (nth 1 a)))                (if (eq calc-language 'latex)
349                      (format "\\text{%s}" (symbol-name (nth 1 a)))
350                    (format "\\hbox{%s}" (symbol-name (nth 1 a))))
351              (if (and math-compose-hash-args              (if (and math-compose-hash-args
352                       (let ((p calc-arg-values))                       (let ((p calc-arg-values))
353                         (setq v 1)                         (setq v 1)
# Line 359  Line 375 
375              (if (eq calc-language 'maple) ""              (if (eq calc-language 'maple) ""
376                (if (memq (nth 1 a) '(0 1)) "(" "["))                (if (memq (nth 1 a) '(0 1)) "(" "["))
377              (math-compose-expr (nth 2 a) 0)              (math-compose-expr (nth 2 a) 0)
378              (if (eq calc-language 'tex) " \\ldots "              (if (memq calc-language '(tex latex)) " \\ldots "
379                (if (eq calc-language 'eqn) " ... " " .. "))                (if (eq calc-language 'eqn) " ... " " .. "))
380              (math-compose-expr (nth 3 a) 0)              (math-compose-expr (nth 3 a) 0)
381              (if (eq calc-language 'maple) ""              (if (eq calc-language 'maple) ""
# Line 404  Line 420 
420              (math-compose-expr (nth 2 a) 0)              (math-compose-expr (nth 2 a) 0)
421              "]]"))              "]]"))
422       ((and (eq (car a) 'calcFunc-sqrt)       ((and (eq (car a) 'calcFunc-sqrt)
423             (eq calc-language 'tex))             (memq calc-language '(tex latex)))
424        (list 'horiz        (list 'horiz
425              "\\sqrt{"              "\\sqrt{"
426              (math-compose-expr (nth 1 a) 0)              (math-compose-expr (nth 1 a) 0)
# Line 440  Line 456 
456                (math-comp-height a1)                (math-comp-height a1)
457                a1 '(rule ?-) a2)))                a1 '(rule ?-) a2)))
458       ((and (memq (car a) '(calcFunc-sum calcFunc-prod))       ((and (memq (car a) '(calcFunc-sum calcFunc-prod))
459             (eq calc-language 'tex)             (memq calc-language '(tex latex))
460             (= (length a) 5))             (= (length a) 5))
461        (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")        (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
462              "_{" (math-compose-expr (nth 2 a) 0)              "_{" (math-compose-expr (nth 2 a) 0)
# Line 495  Line 511 
511             (integerp (nth 2 a)))             (integerp (nth 2 a)))
512        (let ((c (math-compose-expr (nth 1 a) -1)))        (let ((c (math-compose-expr (nth 1 a) -1)))
513          (if (> prec (nth 2 a))          (if (> prec (nth 2 a))
514              (if (eq calc-language 'tex)              (if (memq calc-language '(tex latex))
515                  (list 'horiz "\\left( " c " \\right)")                  (list 'horiz "\\left( " c " \\right)")
516                (if (eq calc-language 'eqn)                (if (eq calc-language 'eqn)
517                    (list 'horiz "{left ( " c " right )}")                    (list 'horiz "{left ( " c " right )}")
# Line 633  Line 649 
649                        (make-list (nth 1 a) c))))))                        (make-list (nth 1 a) c))))))
650       ((and (eq (car a) 'calcFunc-evalto)       ((and (eq (car a) 'calcFunc-evalto)
651             (setq calc-any-evaltos t)             (setq calc-any-evaltos t)
652             (memq calc-language '(tex eqn))             (memq calc-language '(tex latex eqn))
653             (= math-compose-level (if math-comp-tagged 2 1))             (= math-compose-level (if math-comp-tagged 2 1))
654             (= (length a) 3))             (= (length a) 3))
655        (list 'horiz        (list 'horiz
656              (if (eq calc-language 'tex) "\\evalto " "evalto ")              (if (memq calc-language '(tex latex)) "\\evalto " "evalto ")
657              (math-compose-expr (nth 1 a) 0)              (math-compose-expr (nth 1 a) 0)
658              (if (eq calc-language 'tex) " \\to " " -> ")              (if (memq calc-language '(tex latex)) " \\to " " -> ")
659              (math-compose-expr (nth 2 a) 0)))              (math-compose-expr (nth 2 a) 0)))
660       (t       (t
661        (let ((op (and (not (eq calc-language 'unform))        (let ((op (and (not (eq calc-language 'unform))
# Line 651  Line 667 
667                      (/= (nth 3 op) -1))                      (/= (nth 3 op) -1))
668                 (cond                 (cond
669                  ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))                  ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
670                   (if (and (eq calc-language 'tex)                   (if (and (memq calc-language '(tex latex))
671                            (not (math-tex-expr-is-flat a)))                            (not (math-tex-expr-is-flat a)))
672                       (if (eq (car-safe a) '/)                       (if (eq (car-safe a) '/)
673                           (list 'horiz "{" (math-compose-expr a -1) "}")                           (list 'horiz "{" (math-compose-expr a -1) "}")
# Line 668  Line 684 
684                                   (math-compose-expr a -1)                                   (math-compose-expr a -1)
685                                   " right )}")))                                   " right )}")))
686                       (list 'horiz "(" (math-compose-expr a 0) ")"))))                       (list 'horiz "(" (math-compose-expr a 0) ")"))))
687                  ((and (eq calc-language 'tex)                  ((and (memq calc-language '(tex latex))
688                        (memq (car a) '(/ calcFunc-choose calcFunc-evalto))                        (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
689                        (>= prec 0))                        (>= prec 0))
690                   (list 'horiz "{" (math-compose-expr a -1) "}"))                   (list 'horiz "{" (math-compose-expr a -1) "}"))
# Line 694  Line 710 
710                     (and (equal (car op) "^")                     (and (equal (car op) "^")
711                          (eq (math-comp-first-char lhs) ?-)                          (eq (math-comp-first-char lhs) ?-)
712                          (setq lhs (list 'horiz "(" lhs ")")))                          (setq lhs (list 'horiz "(" lhs ")")))
713                     (and (eq calc-language 'tex)                     (and (memq calc-language '(tex latex))
714                          (or (equal (car op) "^") (equal (car op) "_"))                          (or (equal (car op) "^") (equal (car op) "_"))
715                          (not (and (stringp rhs) (= (length rhs) 1)))                          (not (and (stringp rhs) (= (length rhs) 1)))
716                          (setq rhs (list 'horiz "{" rhs "}")))                          (setq rhs (list 'horiz "{" rhs "}")))
# Line 761  Line 777 
777                  ((or (> prec (or (nth 4 op) (nth 2 op)))                  ((or (> prec (or (nth 4 op) (nth 2 op)))
778                       (and (not (eq (assoc (car op) math-expr-opers) op))                       (and (not (eq (assoc (car op) math-expr-opers) op))
779                            (> prec 0)))   ; don't write x% + y                            (> prec 0)))   ; don't write x% + y
780                   (if (and (eq calc-language 'tex)                   (if (and (memq calc-language '(tex latex))
781                            (not (math-tex-expr-is-flat a)))                            (not (math-tex-expr-is-flat a)))
782                       (list 'horiz "\\left( "                       (list 'horiz "\\left( "
783                             (math-compose-expr a -1)                             (math-compose-expr a -1)
# Line 786  Line 802 
802                ((and op (= (length a) 2) (= (nth 2 op) -1))                ((and op (= (length a) 2) (= (nth 2 op) -1))
803                 (cond                 (cond
804                  ((eq (nth 3 op) 0)                  ((eq (nth 3 op) 0)
805                   (let ((lr (and (eq calc-language 'tex)                   (let ((lr (and (memq calc-language '(tex latex))
806                                  (not (math-tex-expr-is-flat (nth 1 a))))))                                  (not (math-tex-expr-is-flat (nth 1 a))))))
807                     (list 'horiz                     (list 'horiz
808                           (if lr "\\left" "")                           (if lr "\\left" "")
# Line 799  Line 815 
815                           (if lr "\\right" "")                           (if lr "\\right" "")
816                           (car (nth 1 (memq op math-expr-opers))))))                           (car (nth 1 (memq op math-expr-opers))))))
817                  ((> prec (or (nth 4 op) (nth 3 op)))                  ((> prec (or (nth 4 op) (nth 3 op)))
818                   (if (and (eq calc-language 'tex)                   (if (and (memq calc-language '(tex latex))
819                            (not (math-tex-expr-is-flat a)))                            (not (math-tex-expr-is-flat a)))
820                       (list 'horiz "\\left( "                       (list 'horiz "\\left( "
821                             (math-compose-expr a -1)                             (math-compose-expr a -1)
# Line 836  Line 852 
852                                        ( pascal . math-compose-pascal )                                        ( pascal . math-compose-pascal )
853                                        ( fortran . math-compose-fortran )                                        ( fortran . math-compose-fortran )
854                                        ( tex . math-compose-tex )                                        ( tex . math-compose-tex )
855                                          ( latex . math-compose-latex )
856                                        ( eqn . math-compose-eqn )                                        ( eqn . math-compose-eqn )
857                                        ( math . math-compose-math )                                        ( math . math-compose-math )
858                                        ( maple . math-compose-maple ))))                                        ( maple . math-compose-maple ))))
# Line 866  Line 883 
883                                 (symbol-name func))))                                 (symbol-name func))))
884                   (if (memq calc-language '(c fortran pascal maple))                   (if (memq calc-language '(c fortran pascal maple))
885                       (setq func (math-to-underscores func)))                       (setq func (math-to-underscores func)))
886                   (if (and (eq calc-language 'tex)                   (if (and (memq calc-language '(tex latex))
887                            calc-language-option                            calc-language-option
888                            (not (= calc-language-option 0))                            (not (= calc-language-option 0))
889                            (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))                            (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
890                       (if (< (prefix-numeric-value calc-language-option) 0)                       (if (< (prefix-numeric-value calc-language-option) 0)
891                           (setq func (format "\\%s" func))                           (setq func (format "\\%s" func))
892                         (setq func (format "\\hbox{%s}" func))))                         (setq func (if (eq calc-language 'latex)
893                                          (format "\\text{%s}" func)
894                                        (format "\\hbox{%s}" func)))))
895                   (if (and (eq calc-language 'eqn)                   (if (and (eq calc-language 'eqn)
896                            (string-match "[^']'+\\'" func))                            (string-match "[^']'+\\'" func))
897                       (let ((n (- (length func) (match-beginning 0) 1)))                       (let ((n (- (length func) (match-beginning 0) 1)))
898                         (setq func (substring func 0 (- n)))                         (setq func (substring func 0 (- n)))
899                         (while (>= (setq n (1- n)) 0)                         (while (>= (setq n (1- n)) 0)
900                           (setq func (concat func " prime")))))                           (setq func (concat func " prime")))))
901                   (cond ((and (eq calc-language 'tex)                   (cond ((and (eq calc-language '(tex latex))
902                               (or (> (length a) 2)                               (or (> (length a) 2)
903                                   (not (math-tex-expr-is-flat (nth 1 a)))))                                   (not (math-tex-expr-is-flat (nth 1 a)))))
904                          (setq left "\\left( "                          (setq left "\\left( "
# Line 889  Line 908 
908                                   (not (math-tex-expr-is-flat (nth 1 a)))))                                   (not (math-tex-expr-is-flat (nth 1 a)))))
909                          (setq left "{left ( "                          (setq left "{left ( "
910                                right " right )}"))                                right " right )}"))
911                         ((and (or (and (eq calc-language 'tex)                         ((and (or (and (memq calc-language '(tex latex))
912                                        (eq (aref func 0) ?\\))                                        (eq (aref func 0) ?\\))
913                                   (and (eq calc-language 'eqn)                                   (and (eq calc-language 'eqn)
914                                        (memq (car a) math-eqn-special-funcs)))                                        (memq (car a) math-eqn-special-funcs)))
915                               (not (string-match "\\hbox{" func))                               (not (or
916                                       (string-match "\\hbox{" func)
917                                       (string-match "\\text{" func)))
918                               (= (length a) 2)                               (= (length a) 2)
919                               (or (Math-realp (nth 1 a))                               (or (Math-realp (nth 1 a))
920                                   (memq (car (nth 1 a)) '(var *))))                                   (memq (car (nth 1 a)) '(var *))))
# Line 968  Line 989 
989        (if (<= count 0)        (if (<= count 0)
990            (if (< count 0)            (if (< count 0)
991                (math-compose-rows (cdr a) -1 nil)                (math-compose-rows (cdr a) -1 nil)
992              (cons (concat (if (eq calc-language 'tex) "  \\ldots" "  ...")              (cons (concat (if (memq calc-language '(tex latex)) "  \\ldots" "  ...")
993                            math-comp-comma)                            math-comp-comma)
994                    (math-compose-rows (cdr a) -1 nil)))                    (math-compose-rows (cdr a) -1 nil)))
995          (cons (list 'horiz          (cons (list 'horiz
# Line 983  Line 1004 
1004    
1005  (defun math-compose-tex-matrix (a)  (defun math-compose-tex-matrix (a)
1006    (if (cdr a)    (if (cdr a)
1007        (cons (math-compose-vector (cdr (car a)) " & " 0)        (cons (append (math-compose-vector (cdr (car a)) " & " 0) '(" \\\\ "))
1008              (cons " \\\\ "              (math-compose-tex-matrix (cdr a)))
                   (math-compose-tex-matrix (cdr a))))  
1009      (list (math-compose-vector (cdr (car a)) " & " 0))))      (list (math-compose-vector (cdr (car a)) " & " 0))))
1010    
1011  (defun math-compose-eqn-matrix (a)  (defun math-compose-eqn-matrix (a)

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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