Mercurial > emacs

comparison lisp/calc/calcsel2.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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