]> code.delx.au - gnu-emacs/blobdiff - lisp/calc/calc-prog.el
(idlwave-sintern-structtag): Declare as a function.
[gnu-emacs] / lisp / calc / calc-prog.el
index 33d183b5c8c58b9e43915c755ad2f77eeec58252..87adf48006dfb52767a88ae7e1d945c34dd1cff6 100644 (file)
@@ -1,26 +1,27 @@
 ;;; 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 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, 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; 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")
         (progn
           (setq cmd-base-default (concat "User-" keyname))
            (setq cmd (completing-read 
-                      (concat "Define M-x command name (default: calc-"
+                      (concat "Define M-x command name (default calc-"
                               cmd-base-default
                               "): ")
                       obarray 'commandp nil
           (setq func 
                  (concat "calcFunc-"
                          (completing-read 
-                          (concat "Define algebraic function name (default: "
+                          (concat "Define algebraic function name (default "
                                   cmd-base-default "): ")
                           (mapcar (lambda (x) (substring x 9))
                                   (all-completions "calcFunc-"
                     (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)))
     (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)
                          (set-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 "#")
             (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))
                               (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 
                        (list 'calc-finish-formula-edit (list 'quote func))
                        nil
-                       (format "Editing formula (%s, %s, bound to %s).\n"
-                               intcmd algcmd kys))
+                       (format (concat
+                                "Editing formula (%s, %s, bound to %s).\n"
+                                "Original formula: %s\n")
+                               intcmd algcmd kys niceexpr))
                      (insert  (math-showing-full-precision
-                                (math-format-nice-expr defn (frame-width)))
+                                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 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)
         (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)
     (delete-char 3)
     (insert "<return>")))
 
-(defvar calc-edit-top)
 (defun calc-edit-macro-finish-edit (cmdname key)
   "Finish editing a Calc macro.
 Redefine the corresponding command."
@@ -1440,15 +1452,22 @@ Redefine the corresponding command."
     (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.