Mercurial > emacs
comparison lisp/calc/calcsel2.el @ 90180:62afea0771d8
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-51
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 289-301)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 68)
- Update from CVS
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Thu, 12 May 2005 03:41:19 +0000 |
| parents | f2ebccfa87d4 9aa364d49b37 |
| children | f042e7c0fe20 |
comparison
equal
deleted
inserted
replaced
| 90179:b745036dab36 | 90180:62afea0771d8 |
|---|---|
| 32 (require 'calc-macs) | 32 (require 'calc-macs) |
| 33 | 33 |
| 34 ;; The variable calc-keep-selection is declared and set in calc-sel.el. | 34 ;; The variable calc-keep-selection is declared and set in calc-sel.el. |
| 35 (defvar calc-keep-selection) | 35 (defvar calc-keep-selection) |
| 36 | 36 |
| 37 ;; The variable calc-sel-reselect is local to the methods below, | |
| 38 ;; but is used by some functions in calc-sel.el which are called | |
| 39 ;; by the functions below. | |
| 40 | |
| 37 (defun calc-commute-left (arg) | 41 (defun calc-commute-left (arg) |
| 38 (interactive "p") | 42 (interactive "p") |
| 39 (if (< arg 0) | 43 (if (< arg 0) |
| 40 (calc-commute-right (- arg)) | 44 (calc-commute-right (- arg)) |
| 41 (calc-wrapper | 45 (calc-wrapper |
| 42 (calc-preserve-point) | 46 (calc-preserve-point) |
| 43 (let ((num (max 1 (calc-locate-cursor-element (point)))) | 47 (let ((num (max 1 (calc-locate-cursor-element (point)))) |
| 44 (reselect calc-keep-selection)) | 48 (calc-sel-reselect calc-keep-selection)) |
| 45 (if (= arg 0) (setq arg nil)) | 49 (if (= arg 0) (setq arg nil)) |
| 46 (while (or (null arg) (>= (setq arg (1- arg)) 0)) | 50 (while (or (null arg) (>= (setq arg (1- arg)) 0)) |
| 47 (let* ((entry (calc-top num 'entry)) | 51 (let* ((entry (calc-top num 'entry)) |
| 48 (expr (car entry)) | 52 (expr (car entry)) |
| 49 (sel (calc-auto-selection entry)) | 53 (sel (calc-auto-selection entry)) |
| 104 (setcar (cdr p) (car p)) | 108 (setcar (cdr p) (car p)) |
| 105 (setcar p sel)))) | 109 (setcar p sel)))) |
| 106 (if (null new) | 110 (if (null new) |
| 107 (if arg | 111 (if arg |
| 108 (error "Term is already leftmost") | 112 (error "Term is already leftmost") |
| 109 (or reselect | 113 (or calc-sel-reselect |
| 110 (calc-pop-push-list 1 (list expr) num '(nil))) | 114 (calc-pop-push-list 1 (list expr) num '(nil))) |
| 111 (setq arg 0)) | 115 (setq arg 0)) |
| 112 (calc-pop-push-record-list | 116 (calc-pop-push-record-list |
| 113 1 "left" | 117 1 "left" |
| 114 (list (calc-replace-sub-formula expr parent new)) | 118 (list (calc-replace-sub-formula expr parent new)) |
| 115 num | 119 num |
| 116 (list (and (or (not (eq arg 0)) reselect) | 120 (list (and (or (not (eq arg 0)) calc-sel-reselect) |
| 117 sel)))))))))) | 121 sel)))))))))) |
| 118 | 122 |
| 119 (defun calc-commute-right (arg) | 123 (defun calc-commute-right (arg) |
| 120 (interactive "p") | 124 (interactive "p") |
| 121 (if (< arg 0) | 125 (if (< arg 0) |
| 122 (calc-commute-left (- arg)) | 126 (calc-commute-left (- arg)) |
| 123 (calc-wrapper | 127 (calc-wrapper |
| 124 (calc-preserve-point) | 128 (calc-preserve-point) |
| 125 (let ((num (max 1 (calc-locate-cursor-element (point)))) | 129 (let ((num (max 1 (calc-locate-cursor-element (point)))) |
| 126 (reselect calc-keep-selection)) | 130 (calc-sel-reselect calc-keep-selection)) |
| 127 (if (= arg 0) (setq arg nil)) | 131 (if (= arg 0) (setq arg nil)) |
| 128 (while (or (null arg) (>= (setq arg (1- arg)) 0)) | 132 (while (or (null arg) (>= (setq arg (1- arg)) 0)) |
| 129 (let* ((entry (calc-top num 'entry)) | 133 (let* ((entry (calc-top num 'entry)) |
| 130 (expr (car entry)) | 134 (expr (car entry)) |
| 131 (sel (calc-auto-selection entry)) | 135 (sel (calc-auto-selection entry)) |
| 187 (setcar p (nth 1 p)) | 191 (setcar p (nth 1 p)) |
| 188 (setcar (cdr p) sel)))) | 192 (setcar (cdr p) sel)))) |
| 189 (if (null new) | 193 (if (null new) |
| 190 (if arg | 194 (if arg |
| 191 (error "Term is already rightmost") | 195 (error "Term is already rightmost") |
| 192 (or reselect | 196 (or calc-sel-reselect |
| 193 (calc-pop-push-list 1 (list expr) num '(nil))) | 197 (calc-pop-push-list 1 (list expr) num '(nil))) |
| 194 (setq arg 0)) | 198 (setq arg 0)) |
| 195 (calc-pop-push-record-list | 199 (calc-pop-push-record-list |
| 196 1 "rght" | 200 1 "rght" |
| 197 (list (calc-replace-sub-formula expr parent new)) | 201 (list (calc-replace-sub-formula expr parent new)) |
| 198 num | 202 num |
| 199 (list (and (or (not (eq arg 0)) reselect) | 203 (list (and (or (not (eq arg 0)) calc-sel-reselect) |
| 200 sel)))))))))) | 204 sel)))))))))) |
| 201 | 205 |
| 202 (defun calc-build-assoc-term (op lhs rhs) | 206 (defun calc-build-assoc-term (op lhs rhs) |
| 203 (cond ((and (eq op '+) (or (math-looks-negp rhs) | 207 (cond ((and (eq op '+) (or (math-looks-negp rhs) |
| 204 (and (eq (car-safe rhs) 'cplx) | 208 (and (eq (car-safe rhs) 'cplx) |
| 223 (defun calc-sel-unpack () | 227 (defun calc-sel-unpack () |
| 224 (interactive) | 228 (interactive) |
| 225 (calc-wrapper | 229 (calc-wrapper |
| 226 (calc-preserve-point) | 230 (calc-preserve-point) |
| 227 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 231 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
| 228 (reselect calc-keep-selection) | 232 (calc-sel-reselect calc-keep-selection) |
| 229 (entry (calc-top num 'entry)) | 233 (entry (calc-top num 'entry)) |
| 230 (expr (car entry)) | 234 (expr (car entry)) |
| 231 (sel (or (calc-auto-selection entry) expr))) | 235 (sel (or (calc-auto-selection entry) expr))) |
| 232 (or (and (not (math-primp sel)) | 236 (or (and (not (math-primp sel)) |
| 233 (= (length sel) 2)) | 237 (= (length sel) 2)) |
| 234 (error "Selection must be a function of one argument")) | 238 (error "Selection must be a function of one argument")) |
| 235 (calc-pop-push-record-list 1 "unpk" | 239 (calc-pop-push-record-list 1 "unpk" |
| 236 (list (calc-replace-sub-formula | 240 (list (calc-replace-sub-formula |
| 237 expr sel (nth 1 sel))) | 241 expr sel (nth 1 sel))) |
| 238 num | 242 num |
| 239 (list (and reselect (nth 1 sel))))))) | 243 (list (and calc-sel-reselect (nth 1 sel))))))) |
| 240 | 244 |
| 241 (defun calc-sel-isolate () | 245 (defun calc-sel-isolate () |
| 242 (interactive) | 246 (interactive) |
| 243 (calc-slow-wrapper | 247 (calc-slow-wrapper |
| 244 (calc-preserve-point) | 248 (calc-preserve-point) |
| 245 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 249 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
| 246 (reselect calc-keep-selection) | 250 (calc-sel-reselect calc-keep-selection) |
| 247 (entry (calc-top num 'entry)) | 251 (entry (calc-top num 'entry)) |
| 248 (expr (car entry)) | 252 (expr (car entry)) |
| 249 (sel (or (calc-auto-selection entry) (error "No selection"))) | 253 (sel (or (calc-auto-selection entry) (error "No selection"))) |
| 250 (eqn sel) | 254 (eqn sel) |
| 251 soln) | 255 soln) |
| 264 (nth 1 soln))))) | 268 (nth 1 soln))))) |
| 265 (calc-pop-push-record-list 1 "isol" | 269 (calc-pop-push-record-list 1 "isol" |
| 266 (list (calc-replace-sub-formula | 270 (list (calc-replace-sub-formula |
| 267 expr eqn soln)) | 271 expr eqn soln)) |
| 268 num | 272 num |
| 269 (list (and reselect sel))) | 273 (list (and calc-sel-reselect sel))) |
| 270 (calc-handle-whys)))) | 274 (calc-handle-whys)))) |
| 271 | 275 |
| 272 (defun calc-sel-commute (many) | 276 (defun calc-sel-commute (many) |
| 273 (interactive "P") | 277 (interactive "P") |
| 274 (let ((calc-assoc-selections nil)) | 278 (let ((calc-assoc-selections nil)) |