emacs: lisp/calc/calc-prog.el comparison

comparison lisp/calc/calc-prog.el @ 105022:af84e9739140

(arglist): Define for compiler. Delete trailing whitespace.

author	Glenn Morris <rgm@gnu.org>
date	Tue, 15 Sep 2009 02:35:22 +0000
parents	14b421290b2f
children	b78ceb253d15

comparison

equal deleted inserted replaced

-:c1a58b7ba6a3
+:af84e9739140
 (unless keyname
 (setq keyname (format "%05d" (abs (% (random) 10000)))))
 (while
 	 (progn
 	   (setq cmd-base-default (concat "User-" keyname))
 (setq cmd (completing-read
 (concat "Define M-x command name (default calc-"
 cmd-base-default
 "): ")
 obarray 'commandp nil
 (if (and odef (symbolp (cdr odef)))
 		      (concat "Replace previous definition for "
 			      (symbol-name cmd) "? ")
 		    "That name conflicts with a built-in Emacs function.  Replace this function? "))))))
 (while
 	 (progn
 (setq cmd-base-default
 (if cmd-base
 (if (string-match
 "\\`User-.+" cmd-base)
 (concat
 "User"
 (substring cmd-base 5))
 cmd-base)
 (concat "User" keyname)))
 	   (setq func
 (concat "calcFunc-"
 (completing-read
 (concat "Define algebraic function name (default "
 cmd-base-default "): ")
 (mapcar (lambda (x) (substring x 9))
 (all-completions "calcFunc-"
 obarray))
 (lambda (x)
 (fboundp
 (intern (concat "calcFunc-" x))))
 nil)))
 (setq func
 (if (string-equal func "calcFunc-")
 (intern (concat "calcFunc-" cmd-base-default))
 (if is-lambda
 	 (setq calc-user-formula-alist arglist)
 (while
 	   (progn
 	     (setq calc-user-formula-alist
 (read-from-minibuffer "Function argument list: "
 (if arglist
 (prin1-to-string arglist)
 "()")
 minibuffer-local-map
 			"Okay for arguments that don't appear in formula to be ignored? "))))))
 (setq is-symb (and calc-user-formula-alist
 			func
 			(y-or-n-p
 			 "Leave it symbolic for non-constant arguments? ")))
 (setq calc-user-formula-alist
 (mapcar (function (lambda (x)
 (or (cdr (assq x '((nil . arg-nil)
 (t . arg-t))))
 x))) calc-user-formula-alist))
 (if cmd
 	   (if old
 	       (setcdr old cmd)
 	     (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 (or (memq (nth 1 form) arglist)
 		  (math-const-var form))
 (interactive)
 (calc-wrapper
 (if (eq calc-language 'unform)
 (error "Can't define formats for unformatted mode"))
 (let* ((comp (calc-top 1))
 	  (func (intern
 (concat "calcFunc-"
 (completing-read "Define format for which function: "
 (mapcar (lambda (x) (substring x 9))
 (all-completions "calcFunc-"
 obarray))
 (lambda (x)
 (fboundp
 (intern (concat "calcFunc-" x))))))))
 	  (comps (get func 'math-compose-forms))
 	  entry entry2
 	  (arglist nil)
 	  (calc-user-formula-alist nil))
 	     (put func 'math-compose-forms (delq entry comps)))
 (calc-default-formula-arglist comp)
 (setq arglist (sort arglist 'string-lessp))
 (while
 	   (progn
 	     (setq calc-user-formula-alist
 (read-from-minibuffer "Composition argument list: "
 (if arglist
 (prin1-to-string arglist)
 "()")
 minibuffer-local-map
 (or (setq entry (assq calc-language comps))
 	   (put func 'math-compose-forms
 		(cons (setq entry (list calc-language)) comps)))
 (or (setq entry2 (assq (length calc-user-formula-alist) (cdr entry)))
 	   (setcdr entry
 		   (cons (setq entry2
 (list (length calc-user-formula-alist))) (cdr entry))))
 (setcdr entry2
 (list 'lambda calc-user-formula-alist (calc-fix-user-formula comp))))
 (calc-pop-stack 1)
 (calc-do-refresh))))
 	  (setq calc-user-parse-tables
 		(delq entry calc-user-parse-tables)))))
 (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
 ;; calc-read-parse-table, but is used by calc-fix-token-name which
 ;; is called (indirectly) by calc-read-parse-table.
 (defvar calc-lang)
 (defun calc-write-parse-table (tab calc-lang)
 	       (and (consp cmd)
 		    (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))
 (kys (nth 3 (nth 3 cmd))))
 (calc-edit-mode
 (list 'calc-edit-macro-finish-edit cmdname kys)
 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)))
 (intcmd (symbol-name (cdr def)))
 (algcmd (if func (substring (symbol-name func) 9) "")))
 	       (if (and defn (calc-valid-formula-func func))
 		   (let ((niceexpr (math-format-nice-expr defn (frame-width))))
 		     (calc-wrapper
 		      (calc-edit-mode
 (list 'calc-finish-formula-edit (list 'quote func))
 nil
 (format (concat
 "Editing formula (%s, %s, bound to %s).\n"
 "Original formula: %s\n")
 (kill-line 1)
 (setq curline (calc-edit-macro-command)))
 (when match
 (kill-line 1)
 (setq line (concat line (substring curline 0 match))))
 (setq line (replace-regexp-in-string "SPC" " SPC "
 (replace-regexp-in-string " " "" line)))
 (insert line "\t\t\t")
 (if (> (current-column) 24)
 (delete-char -1))
 (insert ";; " type "\n")
 (not (string-equal "RET" curline))
 (not (setq match (string-match "<return>" curline))))
 (setq line (concat line curline))
 (kill-line 1)
 (setq curline (calc-edit-macro-command)))
 (when match
 (kill-line 1)
 (setq line (concat line (substring curline 0 match))))
 (setq line (replace-regexp-in-string " " "" line))
 (insert cmdbeg " " line "\t\t\t")
 (if (> (current-column) 24)
 (not (string-equal "RET" curline))
 (not (setq match (string-match "<return>" curline))))
 (setq line (concat line curline))
 (kill-line 1)
 (setq curline (calc-edit-macro-command)))
 (when match
 (kill-line 1)
 (setq line (concat line (substring curline 0 match))))
 (setq line (replace-regexp-in-string " " "" line))
 (insert line "\t\t\t")
 (if (> (current-column) 24)
 (format "Record in %s the algebraic function: "
 calc-settings-file)
 (mapcar (lambda (x) (substring x 9))
 (all-completions "calcFunc-"
 obarray))
 (lambda (x)
 (fboundp
 (intern (concat "calcFunc-" x))))
 t)))))
 (and (eq key ?\M-x)
 			(cons nil
 			      (intern (completing-read

Mercurial > emacs

comparison lisp/calc/calc-prog.el @ 105022:af84e9739140