Function: calc-embedded-make-info

calc-embedded-make-info is a byte-compiled function defined in calc-embed.el.gz.

Signature

(calc-embedded-make-info POINT CBUF FRESH &optional EMBED-TOP EMBED-BOT EMBED-OUTER-TOP EMBED-OUTER-BOT)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-embed.el.gz
(defun calc-embedded-make-info (point cbuf fresh &optional
				      embed-top embed-bot
                                      embed-outer-top embed-outer-bot)
  (let* ((calc-embed-top embed-top)
	 (calc-embed-bot embed-bot)
	 (calc-embed-outer-top embed-outer-top)
	 (calc-embed-outer-bot embed-outer-bot)
	 (bufentry (assq (current-buffer) calc-embedded-active))
	 (found bufentry)
	 (force (and fresh calc-embed-top (null (equal calc-embed-top '(t)))))
	 (fixed calc-embed-top)
	 (new-info nil)
	 info str)
    (or found
        (and
         (setq found (list (current-buffer))
               calc-embedded-active (cons found calc-embedded-active)
               calc-embedded-firsttime-buf t)
         (let ((newann (cl-assoc-if #'derived-mode-p
                                    calc-embedded-announce-formula-alist))
               (newform (cl-assoc-if #'derived-mode-p
                                     calc-embedded-open-close-formula-alist))
               (newword (cl-assoc-if #'derived-mode-p
                                     calc-embedded-word-regexp-alist))
               (newplain (cl-assoc-if #'derived-mode-p
                                      calc-embedded-open-close-plain-alist))
               (newnewform
                (cl-assoc-if #'derived-mode-p
                             calc-embedded-open-close-new-formula-alist))
               (newmode (cl-assoc-if #'derived-mode-p
                                     calc-embedded-open-close-mode-alist)))
           (when newann
             (setq-local calc-embedded-announce-formula (cdr newann)))
           (when newform
             (setq-local calc-embedded-open-formula (nth 0 (cdr newform)))
             (setq-local calc-embedded-close-formula (nth 1 (cdr newform))))
           (when newword
             (setq-local calc-embedded-word-regexp (nth 1 newword)))
           (when newplain
             (setq-local calc-embedded-open-plain (nth 0 (cdr newplain)))
             (setq-local calc-embedded-close-plain (nth 1 (cdr newplain))))
           (when newnewform
             (setq-local calc-embedded-open-new-formula (nth 0 (cdr newnewform)))
             (setq-local calc-embedded-close-new-formula (nth 1 (cdr newnewform))))
           (when newmode
             (setq-local calc-embedded-open-mode (nth 0 (cdr newmode)))
             (setq-local calc-embedded-close-mode (nth 1 (cdr newmode)))))))
    (while (and (cdr found)
		(> point (aref (car (cdr found)) 3)))
      (setq found (cdr found)))
    (if (and (cdr found)
	     (>= point (aref (nth 1 found) 2)))
        (setq info (nth 1 found))
      (setq calc-embedded-firsttime-formula t)
      (setq info (make-vector 16 nil)
	    new-info t
	    fresh t)
      (aset info 0 (current-buffer))
      (aset info 1 (or cbuf (save-excursion
			      (calc-create-buffer)
			      (current-buffer)))))
    (if (and
         (or (integerp calc-embed-top) (equal calc-embed-top '(4)))
         (not calc-embed-bot))
                                        ; started with a user-supplied argument
	(progn
          (if (equal calc-embed-top '(4))
              (progn
                (aset info 2 (copy-marker (line-beginning-position)))
                (aset info 3 (copy-marker (line-end-position))))
            (if (= (setq calc-embed-arg (prefix-numeric-value calc-embed-arg)) 0)
                (progn
                  (aset info 2 (copy-marker (region-beginning)))
                  (aset info 3 (copy-marker (region-end))))
              (aset info (if (> calc-embed-arg 0) 2 3) (point-marker))
              (if (> calc-embed-arg 0)
                  (progn
                    (forward-line (1- calc-embed-arg))
                    (end-of-line))
                (forward-line (1+ calc-embed-arg)))
              (aset info (if (> calc-embed-arg 0) 3 2) (point-marker))))
	  (aset info 4 (copy-marker (aref info 2)))
	  (aset info 5 (copy-marker (aref info 3))))
      (if (aref info 4)
	  (setq calc-embed-top (aref info 2)
		fixed calc-embed-top)
	(if (consp calc-embed-top)
            (progn
              (require 'thingatpt)
              (if (thing-at-point-looking-at calc-embedded-word-regexp)
                  (progn
                    (setq calc-embed-top (copy-marker (match-beginning 0)))
                    (setq calc-embed-bot (copy-marker (match-end 0)))
                    (setq calc-embed-outer-top calc-embed-top)
                    (setq calc-embed-outer-bot calc-embed-bot))
                (setq calc-embed-top (point-marker))
                (setq calc-embed-bot (point-marker))
                (setq calc-embed-outer-top calc-embed-top)
                (setq calc-embed-outer-bot calc-embed-bot)))
	  (or calc-embed-top
	      (calc-embedded-find-bounds 'plain)))
	(aset info 2 (copy-marker (min calc-embed-top calc-embed-bot)))
	(aset info 3 (copy-marker (max calc-embed-top calc-embed-bot)))
	(aset info 4 (copy-marker (or calc-embed-outer-top (aref info 2))))
	(aset info 5 (copy-marker (or calc-embed-outer-bot (aref info 3))))))
    (goto-char (aref info 2))
    (if new-info
	(progn
	  (or (bolp) (aset info 7 t))
	  (goto-char (aref info 3))
	  (or (bolp) (eolp) (aset info 7 t))))
    (if fresh
	(let ((modes (calc-embedded-find-modes)))
	  (aset info 12 (car modes))
	  (aset info 13 (nth 1 modes))
	  (aset info 14 (nth 2 modes))))
    (aset info 15 calc-embedded-globals)
    (setq str (buffer-substring (aref info 2) (aref info 3)))
    (if (or force
	    (not (equal str (aref info 6))))
	(if (and fixed (aref info 6))
	    (progn
	      (aset info 4 nil)
	      (calc-embedded-make-info point cbuf nil)
	      (setq new-info nil))
	  (let* ((open-plain calc-embedded-open-plain)
		 (close-plain calc-embedded-close-plain)
		 (pref-len (length open-plain))
		 (calc-embed-vars-used nil)
		 suff-pos val temp)
	    (with-current-buffer (aref info 1)
	      (calc-embedded-set-modes (aref info 15)
				       (aref info 12) (aref info 14))
	      (if (and (> (length str) pref-len)
		       (equal (substring str 0 pref-len) open-plain)
		       (setq suff-pos (string-match (regexp-quote close-plain)
						    str pref-len)))
		  (setq val (math-read-plain-expr
			     (substring str pref-len suff-pos)))
		(if (string-match "[^ \t\n]" str)
		    (setq pref-len 0
			  val (condition-case nil
                                  (math-read-big-expr str)
                                (error (math-read-expr str))))
		  (setq val nil))))
	    (if (eq (car-safe val) 'error)
		(setq val (list 'error
				(+ (aref info 2) pref-len (nth 1 val))
				(nth 2 val))))
	    (aset info 6 str)
	    (aset info 8 val)
	    (setq temp val)
	    (if (eq (car-safe temp) 'calcFunc-evalto)
		(setq temp (nth 1 temp))
	      (if (eq (car-safe temp) 'error)
		  (if new-info
		      (setq new-info nil)
		    (setcdr found (delq info (cdr found)))
		    (calc-embedded-active-state 'less))))
	    (aset info 9 (and (eq (car-safe temp) 'calcFunc-assign)
			      (nth 1 temp)))
	    (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
		(calc-embedded-find-vars val))
	    (aset info 10 calc-embed-vars-used)
	    (aset info 11 nil))))
    (if new-info
	(progn
	  (setcdr found (cons info (cdr found)))
	  (calc-embedded-active-state 'more)))
    info))