;;; calc-prog.el --- user programmability functions for Calc
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainer: Jay Belanger <belanger@truman.edu>
+;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; This file is part of GNU Emacs.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'calc-ext)
(require 'calc-macs)
+;; Declare functions which are defined elsewhere.
+(declare-function edmacro-format-keys "edmacro" (macro &optional verbose))
+(declare-function edmacro-parse-keys "edmacro" (string &optional need-vector))
+(declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term))
+
(defun calc-equal-to (arg)
(interactive "P")
(defvar math-integral-cache-state)
;; calc-user-formula-alist is local to calc-user-define-formula,
-;; calc-user-define-compostion and calc-finish-formula-edit,
+;; calc-user-define-composition and calc-finish-formula-edit,
;; but is used by calc-fix-user-formula.
(defvar calc-user-formula-alist)
(while
(progn
(setq cmd-base-default (concat "User-" keyname))
- (setq cmd (completing-read
- (concat "Define M-x command name (default: calc-"
+ (setq cmd (completing-read
+ (concat "Define M-x command name (default calc-"
cmd-base-default
"): ")
obarray 'commandp nil
"That name conflicts with a built-in Emacs function. Replace this function? "))))))
(while
(progn
- (setq cmd-base-default
+ (setq cmd-base-default
(if cmd-base
(if (string-match
"\\`User-.+" cmd-base)
(substring cmd-base 5))
cmd-base)
(concat "User" keyname)))
- (setq func
+ (setq func
(concat "calcFunc-"
- (completing-read
- (concat "Define algebraic function name (default: "
+ (completing-read
+ (concat "Define algebraic function name (default "
cmd-base-default "): ")
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
- (lambda (x)
- (fboundp
+ (lambda (x)
+ (fboundp
(intern (concat "calcFunc-" x))))
nil)))
(setq func
(setq calc-user-formula-alist arglist)
(while
(progn
- (setq calc-user-formula-alist
+ (setq calc-user-formula-alist
(read-from-minibuffer "Function argument list: "
(if arglist
(prin1-to-string arglist)
func
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
- (setq calc-user-formula-alist
+ (setq calc-user-formula-alist
(mapcar (function (lambda (x)
(or (cdr (assq x '((nil . arg-nil)
(t . arg-t))))
(setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
(message "")))
+(defvar arglist) ; dynamically bound in all callers
(defun calc-default-formula-arglist (form)
(if (consp form)
(if (eq (car form) 'var)
(if (eq calc-language 'unform)
(error "Can't define formats for unformatted mode"))
(let* ((comp (calc-top 1))
- (func (intern
+ (func (intern
(concat "calcFunc-"
(completing-read "Define format for which function: "
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
- (lambda (x)
- (fboundp
+ (lambda (x)
+ (fboundp
(intern (concat "calcFunc-" x))))))))
(comps (get func 'math-compose-forms))
entry entry2
(setq arglist (sort arglist 'string-lessp))
(while
(progn
- (setq calc-user-formula-alist
+ (setq calc-user-formula-alist
(read-from-minibuffer "Composition argument list: "
(if arglist
(prin1-to-string arglist)
(cons (setq entry (list calc-language)) comps)))
(or (setq entry2 (assq (length calc-user-formula-alist) (cdr entry)))
(setcdr entry
- (cons (setq entry2
+ (cons (setq entry2
(list (length calc-user-formula-alist))) (cdr entry))))
- (setcdr entry2
+ (setcdr entry2
(list 'lambda calc-user-formula-alist (calc-fix-user-formula comp))))
(calc-pop-stack 1)
(calc-do-refresh))))
(format "Editing %s-Mode Syntax Table. "
(cond ((null lang) "Normal")
((eq lang 'tex) "TeX")
+ ((eq lang 'latex) "LaTeX")
(t (capitalize (symbol-name lang))))))
(calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
lang)))
(switch-to-buffer calc-original-buffer))
;; The variable calc-lang is local to calc-write-parse-table, but is
-;; used by calc-write-parse-table-part which is called by
-;; calc-write-parse-table. The variable is also local to
+;; used by calc-write-parse-table-part which is called by
+;; calc-write-parse-table. The variable is also local to
;; calc-read-parse-table, but is used by calc-fix-token-name which
;; is called (indirectly) by calc-read-parse-table.
(defvar calc-lang)
(cond ((stringp (car p))
(let ((s (car p)))
(if (and (string-match "\\`\\\\dots\\>" s)
- (not (eq calc-lang 'tex)))
+ (not (memq calc-lang '(tex latex))))
(setq s (concat ".." (substring s 5))))
(if (or (and (string-match
"[a-zA-Z0-9\"{}]\\|\\`:=\\'\\|\\`#\\|\\`%%" s)
(let ((pos (point)))
(end-of-line)
(let* ((str (buffer-substring pos (point)))
- (exp (save-excursion
- (set-buffer calc-buf)
+ (exp (with-current-buffer calc-buf
(let ((calc-user-parse-tables nil)
(calc-language nil)
- (math-expr-opers math-standard-opers)
+ (math-expr-opers (math-standard-ops))
(calc-hashes-used 0))
(math-read-expr
(if (string-match ",[ \t]*\\'" str)
(defun calc-fix-token-name (name &optional unquoted)
(cond ((string-match "\\`\\.\\." name)
(concat "\\dots" (substring name 2)))
- ((and (equal name "{") (memq calc-lang '(tex eqn)))
+ ((and (equal name "{") (memq calc-lang '(tex latex eqn)))
"(")
- ((and (equal name "}") (memq calc-lang '(tex eqn)))
+ ((and (equal name "}") (memq calc-lang '(tex latex eqn)))
")")
- ((and (equal name "&") (eq calc-lang 'tex))
+ ((and (equal name "&") (memq calc-lang '(tex latex)))
",")
((equal name "#")
(search-backward "#")
(error "Separator not allowed with { ... }?"))
(if (string-match "\\`\"" sep)
(setq sep (read-from-string sep)))
- (setq sep (calc-fix-token-name sep))
+ (if (> (length sep) 0)
+ (setq sep (calc-fix-token-name sep)))
(setq part (nconc part
(list (list sym p
(and (> (length sep) 0)
(setq part (nconc part (list (if (= (match-beginning 1)
(match-end 1))
0
- (string-to-int
+ (string-to-number
(buffer-substring
(1+ (match-beginning 1))
(match-end 1)))))))
(or last-kbd-macro
(error "No keyboard macro defined"))
(setq calc-invocation-macro last-kbd-macro)
- (message "Use `M-# Z' to invoke this macro"))
+ (message "Use `C-x * Z' to invoke this macro"))
(defun calc-user-define-edit ()
(interactive) ; but no calc-wrapper!
(message "Edit definition of command: z-")
- (let* ((key (read-char))
+ (let* (cmdname
+ (key (read-char))
(def (or (assq key (calc-user-key-map))
(assq (upcase key) (calc-user-key-map))
(assq (downcase key) (calc-user-key-map))
(eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
(let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
(str (edmacro-format-keys mac t))
- (macbeg)
(kys (nth 3 (nth 3 cmd))))
- (calc-edit-mode
+ (calc-edit-mode
(list 'calc-edit-macro-finish-edit cmdname kys)
- t (format "Editing keyboard macro (%s, bound to %s).\n"
- cmdname kys))
- (goto-char (point-max))
- (insert "Original keys: " (elt (nth 1 (nth 3 cmd)) 0) "\n" )
- (setq macbeg (point))
+ t (format (concat
+ "Editing keyboard macro (%s, bound to %s).\n"
+ "Original keys: %s \n")
+ cmdname kys (elt (nth 1 (nth 3 cmd)) 0)))
(insert str "\n")
(calc-edit-format-macro-buffer)
- (calc-show-edit-buffer)
- (goto-char (point-min))
- (search-forward "Original")
- (forward-line 2)))
+ (calc-show-edit-buffer)))
(t (let* ((func (calc-stack-command-p cmd))
(defn (and func
(symbolp func)
(get func 'calc-user-defn)))
(kys (concat "z" (char-to-string (car def))))
(intcmd (symbol-name (cdr def)))
- (algcmd (substring (symbol-name func) 9)))
+ (algcmd (if func (substring (symbol-name func) 9) "")))
(if (and defn (calc-valid-formula-func func))
- (progn
+ (let ((niceexpr (math-format-nice-expr defn (frame-width))))
(calc-wrapper
- (calc-edit-mode
+ (calc-edit-mode
(list 'calc-finish-formula-edit (list 'quote func))
nil
- (format "Editing formula (%s, %s, bound to %s).\n"
- intcmd algcmd kys))
- (insert (math-showing-full-precision
- (math-format-nice-expr defn (frame-width)))
- "\n"))
- (calc-show-edit-buffer)
- (goto-char (point-min))
- (forward-line 2))
+ (format (concat
+ "Editing formula (%s, %s, bound to %s).\n"
+ "Original formula: %s\n")
+ intcmd algcmd kys niceexpr))
+ (insert (math-showing-full-precision
+ niceexpr)
+ "\n"))
+ (calc-show-edit-buffer))
(error "That command's definition cannot be edited")))))))
;; Formatting the macro buffer
+(defvar calc-edit-top)
+
(defun calc-edit-macro-repeats ()
- (goto-char (point-min))
+ (goto-char calc-edit-top)
(while
(re-search-forward "^\\([0-9]+\\)\\*" nil t)
- (setq num (string-to-int (match-string 1)))
- (setq line (buffer-substring (point) (line-end-position)))
- (goto-char (line-beginning-position))
- (kill-line 1)
- (while (> num 0)
- (insert line "\n")
- (setq num (1- num)))))
+ (let ((num (string-to-number (match-string 1)))
+ (line (buffer-substring (point) (line-end-position))))
+ (goto-char (line-beginning-position))
+ (kill-line 1)
+ (while (> num 0)
+ (insert line "\n")
+ (setq num (1- num))))))
(defun calc-edit-macro-adjust-buffer ()
(calc-edit-macro-repeats)
- (goto-char (point-min))
+ (goto-char calc-edit-top)
(while (re-search-forward "^RET$" nil t)
(delete-char 1))
- (goto-char (point-min))
+ (goto-char calc-edit-top)
(while (and (re-search-forward "^$" nil t)
(not (= (point) (point-max))))
(delete-char 1)))
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string "SPC" " SPC "
+ (setq line (replace-regexp-in-string "SPC" " SPC "
(replace-regexp-in-string " " "" line)))
(insert line "\t\t\t")
(if (> (current-column) 24)
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
- (when match
+ (when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string " " "" line))
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
- (when match
+ (when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string " " "" line))
(defun calc-edit-format-macro-buffer ()
"Rewrite the Calc macro editing buffer."
(calc-edit-macro-adjust-buffer)
- (goto-char (point-min))
- (search-forward "Original keys:")
- (forward-line 1)
- (insert "\n")
- (skip-chars-forward " \t\n")
+ (goto-char calc-edit-top)
(let ((type (calc-edit-macro-command-type)))
(while (not (string-equal type ""))
(cond
(calc-edit-macro-combine-var-name))
((or
(string-equal type "calc-copy-variable")
+ (string-equal type "calc-copy-special-constant")
(string-equal type "calc-declare-variable"))
(forward-line 1)
(calc-edit-macro-combine-var-name)
(calc-edit-macro-combine-var-name))
(t (forward-line 1)))
(setq type (calc-edit-macro-command-type))))
- (goto-char (point-min)))
+ (goto-char calc-edit-top))
;; Finish editing the macro
(defun calc-edit-macro-pre-finish-edit ()
- (goto-char (point-min))
+ (goto-char calc-edit-top)
(while (re-search-forward "\\(^\\| \\)RET\\($\\|\t\\| \\)" nil t)
(search-backward "RET")
(delete-char 3)
(interactive)
(let ((cmd (intern cmdname)))
(calc-edit-macro-pre-finish-edit)
- (goto-char (point-max))
- (re-search-backward "^Original keys:")
- (forward-line 1)
- (let* ((str (buffer-substring (point) (point-max)))
+ (let* ((str (buffer-substring calc-edit-top (point-max)))
(mac (edmacro-parse-keys str t)))
(if (= (length mac) 0)
(fmakunbound cmd)
'arg key)))))))
(defun calc-finish-formula-edit (func)
- (goto-char (point-min))
- (forward-line 2)
(let ((buf (current-buffer))
- (str (buffer-substring (point) (point-max)))
+ (str (buffer-substring calc-edit-top (point-max)))
(start (point))
(body (calc-valid-formula-func func)))
(set-buffer calc-original-buffer)
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
- (lambda (x)
- (fboundp
+ (lambda (x)
+ (fboundp
(intern (concat "calcFunc-" x))))
t)))))
(and (eq key ?\M-x)
(calc-execute-kbd-macro last-kbd-macro arg))
(defun calc-execute-kbd-macro (mac arg &rest prefix)
+ (if calc-keep-args-flag
+ (calc-keep-args))
(if (and (vectorp mac) (> (length mac) 0) (stringp (aref mac 0)))
(setq mac (or (aref mac 1)
(aset mac 1 (progn (and (fboundp 'edit-kbd-macro)
(calc-pop-stack 1)
(if (math-is-true cond)
(if defining-kbd-macro
- (message "If true.."))
+ (message "If true..."))
(if defining-kbd-macro
(message "Condition is false; skipping to Z: or Z] ..."))
(calc-kbd-skip-to-else-if t)))))
(let* ((count 0)
(parts nil)
(body "")
- (open last-command-char)
+ (open last-command-event)
(counter initial)
ch)
(or executing-kbd-macro
(error "Unbalanced Z' in keyboard macro")))
-(defun calc-kbd-report (msg)
- (interactive "sMessage: ")
- (calc-wrapper
- (math-working msg (calc-top-n 1))))
+;; (defun calc-kbd-report (msg)
+;; (interactive "sMessage: ")
+;; (calc-wrapper
+;; (math-working msg (calc-top-n 1))))
-(defun calc-kbd-query (msg)
- (interactive "sPrompt: ")
- (calc-wrapper
- (calc-alg-entry nil (and (not (equal msg "")) msg))))
+(defun calc-kbd-query ()
+ (interactive)
+ (let ((defining-kbd-macro nil)
+ (executing-kbd-macro nil)
+ (msg (calc-top 1)))
+ (if (not (eq (car-safe msg) 'vec))
+ (error "No prompt string provided")
+ (setq msg (math-vector-to-string msg))
+ (calc-wrapper
+ (calc-pop-stack 1)
+ (calc-alg-entry nil (and (not (equal msg "")) msg))))))
;;;; Logical operations.
(provide 'calc-prog)
-;;; arch-tag: 4c5a183b-c9e5-4632-bb3f-e41a764518b0
+;; arch-tag: 4c5a183b-c9e5-4632-bb3f-e41a764518b0
;;; calc-prog.el ends here