Mercurial > emacs
comparison lisp/calc/calcsel2.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; calcsel2.el --- selection functions for Calc | 1 ;;; calcsel2.el --- selection functions for Calc |
2 | 2 |
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
4 ;; 2005 Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: David Gillespie <daveg@synaptics.com> | 6 ;; Author: David Gillespie <daveg@synaptics.com> |
6 ;; Maintainers: D. Goel <deego@gnufans.org> | 7 ;; Maintainer: Jay Belanger <belanger@truman.edu> |
7 ;; Colin Walters <walters@debian.org> | |
8 | 8 |
9 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
10 | 10 |
11 ;; GNU Emacs is distributed in the hope that it will be useful, | 11 ;; GNU Emacs is distributed in the hope that it will be useful, |
12 ;; but WITHOUT ANY WARRANTY. No author or distributor | 12 ;; but WITHOUT ANY WARRANTY. No author or distributor |
26 ;;; Commentary: | 26 ;;; Commentary: |
27 | 27 |
28 ;;; Code: | 28 ;;; Code: |
29 | 29 |
30 ;; This file is autoloaded from calc-ext.el. | 30 ;; This file is autoloaded from calc-ext.el. |
31 | |
31 (require 'calc-ext) | 32 (require 'calc-ext) |
32 | |
33 (require 'calc-macs) | 33 (require 'calc-macs) |
34 | 34 |
35 (defun calc-Need-calc-sel-2 () nil) | 35 ;; The variable calc-keep-selection is declared and set in calc-sel.el. |
36 | 36 (defvar calc-keep-selection) |
37 | |
38 ;; The variable calc-sel-reselect is local to the methods below, | |
39 ;; but is used by some functions in calc-sel.el which are called | |
40 ;; by the functions below. | |
37 | 41 |
38 (defun calc-commute-left (arg) | 42 (defun calc-commute-left (arg) |
39 (interactive "p") | 43 (interactive "p") |
40 (if (< arg 0) | 44 (if (< arg 0) |
41 (calc-commute-right (- arg)) | 45 (calc-commute-right (- arg)) |
42 (calc-wrapper | 46 (calc-wrapper |
43 (calc-preserve-point) | 47 (calc-preserve-point) |
44 (let ((num (max 1 (calc-locate-cursor-element (point)))) | 48 (let ((num (max 1 (calc-locate-cursor-element (point)))) |
45 (reselect calc-keep-selection)) | 49 (calc-sel-reselect calc-keep-selection)) |
46 (if (= arg 0) (setq arg nil)) | 50 (if (= arg 0) (setq arg nil)) |
47 (while (or (null arg) (>= (setq arg (1- arg)) 0)) | 51 (while (or (null arg) (>= (setq arg (1- arg)) 0)) |
48 (let* ((entry (calc-top num 'entry)) | 52 (let* ((entry (calc-top num 'entry)) |
49 (expr (car entry)) | 53 (expr (car entry)) |
50 (sel (calc-auto-selection entry)) | 54 (sel (calc-auto-selection entry)) |
105 (setcar (cdr p) (car p)) | 109 (setcar (cdr p) (car p)) |
106 (setcar p sel)))) | 110 (setcar p sel)))) |
107 (if (null new) | 111 (if (null new) |
108 (if arg | 112 (if arg |
109 (error "Term is already leftmost") | 113 (error "Term is already leftmost") |
110 (or reselect | 114 (or calc-sel-reselect |
111 (calc-pop-push-list 1 (list expr) num '(nil))) | 115 (calc-pop-push-list 1 (list expr) num '(nil))) |
112 (setq arg 0)) | 116 (setq arg 0)) |
113 (calc-pop-push-record-list | 117 (calc-pop-push-record-list |
114 1 "left" | 118 1 "left" |
115 (list (calc-replace-sub-formula expr parent new)) | 119 (list (calc-replace-sub-formula expr parent new)) |
116 num | 120 num |
117 (list (and (or (not (eq arg 0)) reselect) | 121 (list (and (or (not (eq arg 0)) calc-sel-reselect) |
118 sel)))))))))) | 122 sel)))))))))) |
119 | 123 |
120 (defun calc-commute-right (arg) | 124 (defun calc-commute-right (arg) |
121 (interactive "p") | 125 (interactive "p") |
122 (if (< arg 0) | 126 (if (< arg 0) |
123 (calc-commute-left (- arg)) | 127 (calc-commute-left (- arg)) |
124 (calc-wrapper | 128 (calc-wrapper |
125 (calc-preserve-point) | 129 (calc-preserve-point) |
126 (let ((num (max 1 (calc-locate-cursor-element (point)))) | 130 (let ((num (max 1 (calc-locate-cursor-element (point)))) |
127 (reselect calc-keep-selection)) | 131 (calc-sel-reselect calc-keep-selection)) |
128 (if (= arg 0) (setq arg nil)) | 132 (if (= arg 0) (setq arg nil)) |
129 (while (or (null arg) (>= (setq arg (1- arg)) 0)) | 133 (while (or (null arg) (>= (setq arg (1- arg)) 0)) |
130 (let* ((entry (calc-top num 'entry)) | 134 (let* ((entry (calc-top num 'entry)) |
131 (expr (car entry)) | 135 (expr (car entry)) |
132 (sel (calc-auto-selection entry)) | 136 (sel (calc-auto-selection entry)) |
188 (setcar p (nth 1 p)) | 192 (setcar p (nth 1 p)) |
189 (setcar (cdr p) sel)))) | 193 (setcar (cdr p) sel)))) |
190 (if (null new) | 194 (if (null new) |
191 (if arg | 195 (if arg |
192 (error "Term is already rightmost") | 196 (error "Term is already rightmost") |
193 (or reselect | 197 (or calc-sel-reselect |
194 (calc-pop-push-list 1 (list expr) num '(nil))) | 198 (calc-pop-push-list 1 (list expr) num '(nil))) |
195 (setq arg 0)) | 199 (setq arg 0)) |
196 (calc-pop-push-record-list | 200 (calc-pop-push-record-list |
197 1 "rght" | 201 1 "rght" |
198 (list (calc-replace-sub-formula expr parent new)) | 202 (list (calc-replace-sub-formula expr parent new)) |
199 num | 203 num |
200 (list (and (or (not (eq arg 0)) reselect) | 204 (list (and (or (not (eq arg 0)) calc-sel-reselect) |
201 sel)))))))))) | 205 sel)))))))))) |
202 | 206 |
203 (defun calc-build-assoc-term (op lhs rhs) | 207 (defun calc-build-assoc-term (op lhs rhs) |
204 (cond ((and (eq op '+) (or (math-looks-negp rhs) | 208 (cond ((and (eq op '+) (or (math-looks-negp rhs) |
205 (and (eq (car-safe rhs) 'cplx) | 209 (and (eq (car-safe rhs) 'cplx) |
224 (defun calc-sel-unpack () | 228 (defun calc-sel-unpack () |
225 (interactive) | 229 (interactive) |
226 (calc-wrapper | 230 (calc-wrapper |
227 (calc-preserve-point) | 231 (calc-preserve-point) |
228 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 232 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
229 (reselect calc-keep-selection) | 233 (calc-sel-reselect calc-keep-selection) |
230 (entry (calc-top num 'entry)) | 234 (entry (calc-top num 'entry)) |
231 (expr (car entry)) | 235 (expr (car entry)) |
232 (sel (or (calc-auto-selection entry) expr))) | 236 (sel (or (calc-auto-selection entry) expr))) |
233 (or (and (not (math-primp sel)) | 237 (or (and (not (math-primp sel)) |
234 (= (length sel) 2)) | 238 (= (length sel) 2)) |
235 (error "Selection must be a function of one argument")) | 239 (error "Selection must be a function of one argument")) |
236 (calc-pop-push-record-list 1 "unpk" | 240 (calc-pop-push-record-list 1 "unpk" |
237 (list (calc-replace-sub-formula | 241 (list (calc-replace-sub-formula |
238 expr sel (nth 1 sel))) | 242 expr sel (nth 1 sel))) |
239 num | 243 num |
240 (list (and reselect (nth 1 sel))))))) | 244 (list (and calc-sel-reselect (nth 1 sel))))))) |
241 | 245 |
242 (defun calc-sel-isolate () | 246 (defun calc-sel-isolate () |
243 (interactive) | 247 (interactive) |
244 (calc-slow-wrapper | 248 (calc-slow-wrapper |
245 (calc-preserve-point) | 249 (calc-preserve-point) |
246 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 250 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
247 (reselect calc-keep-selection) | 251 (calc-sel-reselect calc-keep-selection) |
248 (entry (calc-top num 'entry)) | 252 (entry (calc-top num 'entry)) |
249 (expr (car entry)) | 253 (expr (car entry)) |
250 (sel (or (calc-auto-selection entry) (error "No selection"))) | 254 (sel (or (calc-auto-selection entry) (error "No selection"))) |
251 (eqn sel) | 255 (eqn sel) |
252 soln) | 256 soln) |
265 (nth 1 soln))))) | 269 (nth 1 soln))))) |
266 (calc-pop-push-record-list 1 "isol" | 270 (calc-pop-push-record-list 1 "isol" |
267 (list (calc-replace-sub-formula | 271 (list (calc-replace-sub-formula |
268 expr eqn soln)) | 272 expr eqn soln)) |
269 num | 273 num |
270 (list (and reselect sel))) | 274 (list (and calc-sel-reselect sel))) |
271 (calc-handle-whys)))) | 275 (calc-handle-whys)))) |
272 | 276 |
273 (defun calc-sel-commute (many) | 277 (defun calc-sel-commute (many) |
274 (interactive "P") | 278 (interactive "P") |
275 (let ((calc-assoc-selections nil)) | 279 (let ((calc-assoc-selections nil)) |
294 | 298 |
295 (defun calc-sel-invert (many) | 299 (defun calc-sel-invert (many) |
296 (interactive "P") | 300 (interactive "P") |
297 (calc-rewrite-selection "InvertRules" many "jinv")) | 301 (calc-rewrite-selection "InvertRules" many "jinv")) |
298 | 302 |
303 (provide 'calcsel2) | |
304 | |
305 ;;; arch-tag: 7c5b8d65-b8f0-45d9-820d-9930f8ee114b | |
299 ;;; calcsel2.el ends here | 306 ;;; calcsel2.el ends here |