Function: calc-commute-left

calc-commute-left is an autoloaded, interactive and byte-compiled function defined in calcsel2.el.gz.

Signature

(calc-commute-left ARG)

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calcsel2.el.gz
(defun calc-commute-left (arg)
  (interactive "p")
  (if (< arg 0)
      (calc-commute-right (- arg))
    (calc-wrapper
     (calc-preserve-point)
     (let ((num (max 1 (calc-locate-cursor-element (point))))
	   (calc-sel-reselect calc-keep-selection))
       (if (= arg 0) (setq arg nil))
       (while (or (null arg) (>= (setq arg (1- arg)) 0))
	 (let* ((entry (calc-top num 'entry))
		(expr (car entry))
		(sel (calc-auto-selection entry))
		parent new)
	   (or (and sel
		    (consp (setq parent (calc-find-assoc-parent-formula
					 expr sel))))
	       (error "No term is selected"))
	   (if (and calc-assoc-selections
		    (assq (car parent) calc-assoc-ops))
	       (let ((outer (calc-find-parent-formula parent sel)))
		 (if (eq sel (nth 2 outer))
		     (setq new (calc-replace-sub-formula
				parent outer
				(cond
				 ((memq (car outer)
					(nth 1 (assq (car-safe (nth 1 outer))
						     calc-assoc-ops)))
				  (let* ((other (nth 2 (nth 1 outer)))
					 (new (calc-build-assoc-term
					       (car (nth 1 outer))
					       (calc-build-assoc-term
						(car outer)
						(nth 1 (nth 1 outer))
						sel)
					       other)))
				    (setq sel (nth 2 (nth 1 new)))
				    new))
				 ((eq (car outer) '-)
				  (calc-build-assoc-term
				   '+
				   (setq sel (math-neg sel))
				   (nth 1 outer)))
				 ((eq (car outer) '/)
				  (calc-build-assoc-term
				   '*
				   (setq sel (calcFunc-div 1 sel))
				   (nth 1 outer)))
				 (t (calc-build-assoc-term
				     (car outer) sel (nth 1 outer))))))
		   (let ((next (calc-find-parent-formula parent outer)))
		     (if (not (and (consp next)
				   (eq outer (nth 2 next))
				   (eq (car next) (car outer))))
			 (setq new nil)
		       (setq new (calc-build-assoc-term
				  (car next)
				  sel
				  (calc-build-assoc-term
				   (car next) (nth 1 next) (nth 2 outer)))
			     sel (nth 1 new)
			     new (calc-replace-sub-formula
				  parent next new))))))
	     (if (eq (nth 1 parent) sel)
		 (setq new nil)
	       (let ((p (nthcdr (1- (calc-find-sub-formula parent sel))
				(setq new (copy-sequence parent)))))
		 (setcar (cdr p) (car p))
		 (setcar p sel))))
	   (if (null new)
	       (if arg
		   (error "Term is already leftmost")
		 (or calc-sel-reselect
		     (calc-pop-push-list 1 (list expr) num '(nil)))
		 (setq arg 0))
	     (calc-pop-push-record-list
	      1 "left"
	      (list (calc-replace-sub-formula expr parent new))
	      num
	      (list (and (or (not (eq arg 0)) calc-sel-reselect)
			 sel))))))))))