From 2845f6fd61b1945a54d336277252c9bb932858b5 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Wed, 29 Jul 2009 03:42:19 +0000 Subject: [PATCH] (calc-transpose-lines): New function. --- lisp/calc/calc-misc.el | 115 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 114 insertions(+), 1 deletion(-) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 7637a9e3260..7e89fecad83 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -57,7 +57,7 @@ (declare-function math-pow-of-zero "calc-arith" (a b)) (declare-function math-pow-zero "calc-arith" (a b)) (declare-function math-pow-fancy "calc-arith" (a b)) - +(declare-function calc-locate-cursor-element "calc-yank" (pt)) ;;;###autoload (defun calc-dispatch-help (arg) @@ -452,6 +452,119 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). (t (calc-roll-up-stack (calc-stack-size) (- nn))))))) +;;;###autoload +(defun calc-transpose-lines (&optional arg) + "Transpose previous line and current line. +With argument ARG, move previous line past ARG lines. +With argument 0, switch line point is in with line mark is in." + (interactive "p") + (setq arg (or arg 1)) + (let (bot-line mid-line end-line + old-top-list new-top-list + bot-cell mid-cell + prev-mid-cell post-mid-cell post-bot-cell) + (calc-wrapper + (when (eq major-mode 'calc-mode) + (cond + ;; exchange point and mark + ((= 0 arg) + (setq bot-line (calc-locate-cursor-element (point)) + mid-line (mark)) + (if mid-line + (setq mid-line (calc-locate-cursor-element mid-line) + end-line (1+ mid-line)) + (error "No mark set")) + (if (< bot-line mid-line) + (let ((temp mid-line)) + (setq mid-line bot-line + bot-line temp)))) + ;; move bot-line to mid-line that is above bot-line on stack (that is + ;; to say mid-line displayed below bot-line in *Calculator* buffer) + ((> arg 0) + (setq bot-line (1+ (calc-locate-cursor-element (point))) + mid-line (- bot-line arg) + end-line mid-line)) + ;; move bot-line to mid-line that is above bot-line on stack (that is + ;; to say mid-line displayed below bot-line in *Calculator* buffer) + ((< arg 0) + (setq mid-line (1+ (calc-locate-cursor-element (point))) + bot-line (- mid-line arg) + end-line bot-line))) + (calc-check-stack bot-line) + (if (= 0 mid-line) + (error "Can't transpose beyond top")) + (setq old-top-list (nreverse (calc-top-list bot-line))) + ;; example: (arg = 2) + ;; old-top-list = + ;; 1 <-- top of stack (bottom of *Calculator* buffer) + ;; 2 + ;; 3 <-- mid-line = 3 + ;; 4 <-- point + ;; 5 <-- bot-line = 5 + (dotimes (i mid-line) + (setq mid-cell old-top-list + old-top-list (cdr old-top-list)) + (setcdr mid-cell new-top-list) + (setq new-top-list mid-cell)) + ;; example follow-up: + ;; old-top-list = + ;; 4 + ;; 5 + ;; new-top-list = + ;; 3 <-- mid-cell + ;; 2 + ;; 1 + (setq prev-mid-cell old-top-list) + (dotimes (i (- bot-line mid-line)) + (setq bot-cell old-top-list + old-top-list (cdr old-top-list)) + (setcdr bot-cell new-top-list) + (setq new-top-list bot-cell)) + (setq post-mid-cell (cdr mid-cell) + post-bot-cell (cdr bot-cell)) + ;; example follow-up: + ;; new-top-list = + ;; 5 <-- bot-cell + ;; 4 <-- prev-mid-cell & post-bot-cell + ;; 3 <-- mid-cell + ;; 2 <-- post-mid-cell + ;; 1 + (cond + ((= 0 arg); swap bot and mid + (setcdr mid-cell post-bot-cell) + (setcdr bot-cell post-mid-cell) + (setcdr prev-mid-cell bot-cell) + ;; example follow-up: + ;; 3 <-- mid-cell + ;; 4 <-- post-bot-cell & prev-mid-cell + ;; 5 <-- bot-cell + ;; 2 <-- post-mid-cell + ;; 1 + (setq new-top-list mid-cell)) + ((< 0 arg) ; move bot just after mid + (setcdr mid-cell bot-cell) + (setcdr bot-cell post-mid-cell) + ;; example follow-up: + ;; new-top-list = + ;; 4 <-- post-bot-cell + ;; 3 <-- mid-cell + ;; 5 <-- bot-cell + ;; 2 <-- post-mid-cell + ;; 1 + (setq new-top-list post-bot-cell)) + ((> 0 arg) ; move mid just before bot + (setcdr mid-cell bot-cell) + (setcdr prev-mid-cell post-mid-cell) + ;; example follow-up: + ;; new-top-list = + ;; 3 <-- mid-cell + ;; 5 <-- bot-cell + ;; 4 <-- prev-mid-cell + ;; 2 <-- post-mid-cell + ;; 1 + (setq new-top-list mid-cell))) + (calc-pop-push-list bot-line new-top-list))) + (calc-cursor-stack-index (1- end-line)))) -- 2.11.4.GIT