;; ;; Written by Joakim Hove ;; Suggestion/modifications/error reports welcome. ;; ;; Interactive function is M-x mcalc. ;; ;; Uses emacs21 hash functions, so emacs21 is required. ;; ;; License: ;; ;; Copyright (C) 2002 Joakim Hove ;; ;; This file is NOT a part of GNU Emacs. ;; ;; This 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 2 of ;; the License, or (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; 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 this program; if not, write to the Free ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ;; MA 02111-1307, USA. ;; ;; Please send suggestions and bug reports to ;; The latest version of this package should be available at ;; ;; ;; ;; ;; This is a very simple RPN based calculator - entirely living in ;; the minibuffer, it is fast, simple to extend and that is about it, ;; but I like it myself .... ;; ;; See C-h f mcalc/mcalc-add-function/mcalc-binary-function for ;; documentation. (require 'cl) ;; Functions with the name mcalc-define-xxx implement the mathematical ;; function xxx, for instance ;; ;; (defun mcalc-define-cosh (arg) ;; (* 0.5 (+ (exp arg) (exp (- arg))))) ;; ;; implements the function cosh(x). Then the mcalc function mcalc-cosh ;; can call this in a manner similar to the way mcalc-sin calls the ;; (built in) sin(x) function. ;; Ripped from calculator.el by Eli Barzilay: (defun mcalc-define-factorial (x) "Simple factorial of X." (let ((r (if (<= x 10) 1 1.0))) (while (> x 0) (setq r (* r (truncate x))) (setq x (1- x))) r)) (defun mcalc-define-binom (arg1 arg2) (let ((over (mcalc-define-factorial arg1)) (under (* (mcalc-define-factorial arg2) (mcalc-define-factorial (- arg1 arg2))))) (/ over under))) (defun mcalc-define-RPM (RPM) (- (* RPM 0.083) 3.61)) (defun mcalc-define-pow (arg1 arg2) (exp (* arg2 (log arg1)))) (defun mcalc-define-cosh (arg) (* 0.5 (+ (exp arg) (exp (- arg))))) (defun mcalc-define-sinh (arg) (* 0.5 (- (exp arg) (exp (- arg))))) (defun mcalc-define-tanh (arg) (/ (mcalc-define-sinh arg) (mcalc-define-cosh arg))) (defun mcalc-define-acosh(arg) (log (+ arg (sqrt (1- (* arg arg)))))) (defun mcalc-define-asinh(arg) (log (+ arg (sqrt (1+ (* arg arg)))))) (defun mcalc-define-ch-sign(arg) (* -1 arg)) (defun mcalc-define-rad (arg) (* pi (/ (float arg) 180))) (defun mcalc-define-deg (arg) (* 180 (/ (float arg) pi))) (defun mcalc-define-sqr (arg) (* arg arg)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions (defvar mcalc-func-hash (make-hash-table :test 'equal) "Hash table containg the functions available to the mcalc calculator. See the dcoumentation of the function `mcalc-add-function' for details of this hash table, and usage.") ;;(defvar mcalc-stack (clrhash mcalc-func-hash) (defun mcalc-add (arglist) (mcalc-binary-func '+ arglist)) (defun mcalc-sub (arglist) (mcalc-binary-func '- arglist)) (defun mcalc-mul (arglist) (mcalc-binary-func '* arglist)) ;; ;; The use of (float ) to avoid 1 / 2 = 0 ;; was suggested by: Thomas Link ;; (defun mcalc-float-div (arglist) (let ((arg1 (float (nth 0 arglist))) (arg2 (nth 1 arglist))) (list (/ arg1 arg2)))) (defun mcalc-int-div (arglist) (mcalc-binary-func '/ arglist)) (defun mcalc-pow (arglist) (mcalc-binary-func 'mcalc-define-pow arglist)) (defun mcalc-RPM (arglist) (mcalc-unary-func 'mcalc-define-RPM arglist)) (defun mcalc-ch-sign(arglist) (mcalc-unary-func 'mcalc-define-ch-sign arglist)) (defun mcalc-factorial (arglist) (mcalc-unary-func 'mcalc-define-factorial arglist)) (defun mcalc-binom (arglist) (mcalc-binary-func 'mcalc-define-binom arglist)) (defun mcalc-sin (arglist) (mcalc-unary-func 'sin arglist)) (defun mcalc-tan (arglist) (mcalc-unary-func 'tan arglist)) (defun mcalc-cosh (arglist) (mcalc-unary-func 'mcalc-define-cosh arglist)) (defun mcalc-acosh (arglist) (mcalc-unary-func 'mcalc-define-acosh arglist)) (defun mcalc-sinh (arglist) (mcalc-unary-func 'mcalc-define-sinh arglist)) (defun mcalc-asinh (arglist) (mcalc-unary-func 'mcalc-define-asinh arglist)) (defun mcalc-tanh (arglist) (mcalc-unary-func 'mcalc-define-tanh arglist)) (defun mcalc-cos (arglist) (mcalc-unary-func 'cos arglist)) (defun mcalc-asin (arglist) (mcalc-unary-func 'asin arglist)) (defun mcalc-atan (arglist) (mcalc-unary-func 'atan arglist)) (defun mcalc-acos (arglist) (mcalc-unary-func 'acos arglist)) (defun mcalc-inv (arglist) (list (/ 1.0 (nth 0 arglist)))) (defun mcalc-sqrt (arglist) (mcalc-unary-func 'sqrt arglist)) (defun mcalc-ln (arglist) (mcalc-unary-func 'log arglist)) (defun mcalc-log10 (arglist) (mcalc-unary-func 'log10 arglist)) (defun mcalc-exp (arglist) (mcalc-unary-func 'exp arglist)) (defun mcalc-deg (arglist) (mcalc-unary-func 'mcalc-define-deg arglist)) (defun mcalc-rad (arglist) (mcalc-unary-func 'mcalc-define-rad arglist)) (defun mcalc-sqr (arglist) (mcalc-unary-func 'mcalc-define-sqr arglist)) (defun mcalc-exch (arglist) (let ((arg1 (nth 0 arglist)) (arg2 (nth 1 arglist))) (list arg2 arg1))) (defun mcalc-dup (arglist) (let ((arg (nth 0 arglist))) (list arg arg))) (defun mcalc-del (arglist) nil) (defun mcalc-quit (arglist) (throw 'quit 't)) (defun mcalc-store (arglist) (let* ((arg (nth 0 arglist)) (var-name (read-from-minibuffer (format "Variable to store %g in: " arg)))) (mcalc-add-constant var-name arg) (list arg))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mcalc-format-string (number) (format "%g" number)) (defun mcalc-format-stack-element (element) (mcalc-format-string element)) (defun mcalc-stack-to-string () (let ((format-stack "(")) (dolist (element mcalc-stack) (setq format-stack (concat format-stack (mcalc-format-stack-element element) " "))) (if (> (length mcalc-stack) 0) (concat (substring format-stack 0 (1- (length format-stack))) ")") (concat format-stack ")")))) (defun mcalc-string-to-float (float-string) (let* ((parse-pair (read-from-string float-string)) (parse-float (nth 0 parse-pair))) (if (numberp parse-float) parse-float nil))) (defun mcalc-get-function (read-string) (gethash read-string mcalc-func-hash)) (defun mcalc-n-pop (n) "Takes off the last n elements of `mcalc-stack', and returning them as a new list. Leaves `mcalc-stack' unchanged and returns nil if n is greater than the length of mcalc-stack." (if (>= (length mcalc-stack) n) (let ((call-stack) (element) (index (- (length mcalc-stack) n))) (while (< index (length mcalc-stack)) (setq element (nth index mcalc-stack)) (push element call-stack) (setq index (1+ index))) (setq mcalc-stack (butlast mcalc-stack n)) (reverse call-stack)) nil)) (defun mcalc-n-push (new-list) "Appends a new list to mcalc-stack, doing nothing if the new list empty." (if new-list (setq mcalc-stack (append mcalc-stack new-list)))) (defun mcalc-read () (read-from-minibuffer (format "%s =>" (mcalc-stack-to-string)) nil mcalc-keymap)) (defun mcalc-add-constant (call-name value) "Small utility function to add numeric constants to the mcalc function table. In mcalc jargon a constant is a function taking no arguments, and returning one value, i.e. \"pi\" could be implemented as: (defun mcalc-pi (arglist) (list 3.14159265)) (mcalc-add-function \"pi\" 'mcalc-pi 0) The function mcalc-add-constant is a utility function to reduce the required typing when adding functions of this kind. Using this function \"pi\" can be implemented as simply as: (mcalc-add-constant \"pi\" 3.151592). The first argument to mcalc-add-constant is the name to use for the constant, e.g. \"pi\", and the second argument is the numerical value." (let* ((func-name (format "mcalc-constant-%s" call-name)) (defun-string (format "(defun %s (arglist) (list %s))" func-name value)) (defun-form (car (read-from-string defun-string)))) (eval defun-form) (puthash call-name (list (car (read-from-string func-name)) 0) mcalc-func-hash))) (defun mcalc-add-function (call-name function narg) "Small utility function to add a new function to the \"mcalc\" function table. First argument (string) is the name of the function when called from \"mcalc\", the second the actual function to call, a symbol, and finally the number of arguments required for this particular function. See `mcalc-binary-func' for details of how to implement your own functions. Internally the function table in \"mcalc\" is stored in the hash-table `mcalc-func-hash', where the key is the short name given to invoke the function, and value is a list of two elemtent, the function to actually compute and the number of arguments. The entries for \"sin\" and \"+\" look like: (puthash \"sin\" (list mcalc-sin 1) mcalc-func-hash) (puthash \"+\" (list mcalc-add 2) mcalc-func-hash) The function `mcalc-add-function' is a small wrapper to reduce the typing, and avoid direct contact with the function table. The two entries above should be coded: (mcalc-add-function \"sin\" \'mcalc-sin 1) (mcalc-add-function \"+\" \'mcalc-add 2) There is another wrapper function, `mcalc-add-constant' designed to add constants to the function table, such that is not necessary to write a simple function just to return a constant. The \"mcalc-func-hash\" table is a global variable coming into effect when \"mcalc\" has been loaded the first time, so if you wish to add your own functions from e.g. \"~/.emacs\" you should wrap it in a (eval-after-load ) form: (eval-after-load \"mcalc\" (progn (mcalc-add-function \"myf1\" \'my-mcalc-function1 7) (mcalc-add-function \"myf2\" \'my-mcalc-function2 7))) Will guarantee that the `mcalc-func-hash' has come into scope when your functions are added." (puthash call-name (list function narg) mcalc-func-hash)) (defun mcalc-binary-func (function arglist) "Utility function to call binary function as mcalc function, binary functions are functions which take *two* arguments, like \"+\" and \"*\". The mcalc functions should all take their arguments as *one list*, and return their result(s) as a list. So for instance the function \"mcalc-add\" can be implemented as follows: (defun mcalc-add (arglist) (let ((arg1 (nth 0 arglist)) (arg2 (nth 1 arglist))) (list (+ arg1 arg2)))) This function takes in a list containing two arguments, extracts the two arguments into two scalars, adds them together and returns the result as a list with one element. Since this is such a common operation, i.e. two scalars in and one scalar out the function `mcalc-binary-func' is written as a utility function. With the use of `mcalc-binary-func' the \"mcalc-add\" would be written: (defun mcalc-add (arglist) (mcalc-binary-func '+ arglist)) In addition there is a similar utility function for unary functions, called \"mcalc-unary-func\". If you want add an other type of function i.e. function taking neither one nor two arguments, or returning different from one scalar in the result you must write it yourself according to \"list in\" -> \"list out\" prescription. The function \"mcalc-exch\" which exchanges the two last arguments on the stack, is for instance implemented like: (defun mcalc-exch (arglist) (let ((arg1 (nth 0 arglist)) (arg2 (nth 1 arglist))) (list arg2 arg1)))." (list (funcall function (nth 0 arglist) (nth 1 arglist)))) (defun mcalc-unary-func (function arglist) "Utility function to call unary function as mcalc function, unary functions are functions which take *one* argument, like sin(x), and ln(x). See `mcalc-binary-func' for more extensive documentation of the mcalc functions." (list (funcall function (nth 0 arglist)))) (defun mcalc-help (arglist) (let ((help-prompt "Available functions:")) (maphash (lambda (key value) (setq help-prompt (concat help-prompt " " key))) mcalc-func-hash) (setq help-prompt (concat help-prompt " ")) (read-from-minibuffer help-prompt)) nil) (defun mcalc-is-elementary-operator (op) (or (string-equal op "*") (string-equal op "+") (string-equal op "-") (string-equal op "/"))) (defun mcalc-last-char (string) (substring string (1- (length string)))) (defun mcalc-but-last-char (string) (if (> (length string) 1) (substring string 0 (1- (length string))) nil)) ;;(defun mcalc () ;; "mcalc provides a small RPN based calculator - entirely living in ;;the minibuffer. Type in numbers or functions followed by return. \"?\" to ;;get a list of functions. ;; ;;It is easy to extend mcalc, see the documentation of the functions ;;\"mcalc-add-function\" and \"mcalc-binary-func\" for details." ;; ;; (interactive) ;; (let ((mcalc-stack)) ;; (catch 'quit ;; (while 't ;; (let* ((read-value (mcalc-read)) ;; (function-p (mcalc-get-function read-value)) ;; (value-list)) ;; (if (string-equal read-value "q") (throw 'quit 't)) ;; (if function-p ;; (let* ((function (nth 0 function-p)) ;; (call-stack-N (nth 1 function-p)) ;; (call-stack (mcalc-n-pop call-stack-N))) ;; (setq value-list (if (or call-stack (equal 0 call-stack-N)) (funcall function call-stack) nil))) ;; (let ((new-float (mcalc-string-to-float read-value))) ;; (if new-float (setq value-list (list new-float))))) ;; (mcalc-n-push value-list)))))) ;; ;; The version of mcalc () below, and the entire mcalc-eval function ;; are contributed by: Ivan Raikov ;; (defun mcalc () "mcalc provides a small RPN based calculator - entirely living in the minibuffer. Usage: ------ Numbers are entered by just entering the number, followed by or . Functions with one character names e.g. \"+\" and \"-\" are activated immediately, wheras functions with longer names e.g. \"sin\" or \"ln\" must be activated with or . There is tab-completion on function names. \"?\" to get a list of functions. It is easy to extend mcalc, see the documentation of the functions `mcalc-add-function' and `mcalc-binary-func' for details." (interactive) (let ((mcalc-stack)) (catch 'quit (while 't (let* ((read-value (split-string (mcalc-read) " ")) (operator (mcalc-last-char (nth 0 read-value))) (numeric-arg)) (if (mcalc-is-elementary-operator operator) (setq numeric-arg (mcalc-but-last-char (nth 0 read-value)))) (if numeric-arg (mapcar 'mcalc-eval (list numeric-arg operator)) (mapcar 'mcalc-eval read-value))))))) (defun mcalc-eval (read-value) (let* ((function-p (mcalc-get-function read-value)) (value-list)) (if function-p (let* ((function (nth 0 function-p)) (call-stack-N (nth 1 function-p)) (call-stack (mcalc-n-pop call-stack-N))) (setq value-list (if (or call-stack (equal 0 call-stack-N)) (funcall function call-stack) nil))) (let ((new-float (mcalc-string-to-float read-value))) (if new-float (setq value-list (list new-float))))) (mcalc-n-push value-list))) (mcalc-add-function "q" 'mcalc-quit 0) (mcalc-add-function "?" 'mcalc-help 0) (mcalc-add-function "s" 'mcalc-store 1) (mcalc-add-function "m" 'mcalc-ch-sign 1) (mcalc-add-function "!" 'mcalc-factorial 1) (mcalc-add-function "sin" 'mcalc-sin 1) (mcalc-add-function "cos" 'mcalc-cos 1) (mcalc-add-function "tan" 'mcalc-tan 1) (mcalc-add-function "asin" 'mcalc-asin 1) (mcalc-add-function "acos" 'mcalc-acos 1) (mcalc-add-function "atan" 'mcalc-atan 1) (mcalc-add-function "cosh" 'mcalc-cosh 1) (mcalc-add-function "acosh" 'mcalc-acosh 1) (mcalc-add-function "sinh" 'mcalc-sinh 1) (mcalc-add-function "asinh" 'mcalc-asinh 1) (mcalc-add-function "tanh" 'mcalc-tanh 1) (mcalc-add-function "inv" 'mcalc-inv 1) (mcalc-add-function "sqrt" 'mcalc-sqrt 1) (mcalc-add-function "sqr" 'mcalc-sqr 1) (mcalc-add-function "ln" 'mcalc-ln 1) (mcalc-add-function "log10" 'mcalc-log10 1) (mcalc-add-function "exp" 'mcalc-exp 1) (mcalc-add-function "d" 'mcalc-del 1) (mcalc-add-function "dup" 'mcalc-dup 1) (mcalc-add-function "deg" 'mcalc-deg 1) (mcalc-add-function "rad" 'mcalc-rad 1) (mcalc-add-function "RPM" 'mcalc-RPM 1) (mcalc-add-function "bin" 'mcalc-binom 2) (mcalc-add-function "*" 'mcalc-mul 2) (mcalc-add-function "/" 'mcalc-float-div 2) (mcalc-add-function "div" 'mcalc-int-div 2) (mcalc-add-function "+" 'mcalc-add 2) (mcalc-add-function "-" 'mcalc-sub 2) (mcalc-add-function "pow" 'mcalc-pow 2) (mcalc-add-function "exch" 'mcalc-exch 2) (mcalc-add-constant "pi" pi) (mcalc-add-constant "kb" 1.38066e-23) (mcalc-add-constant "ev" 1.6019e-19) (mcalc-add-constant "h" 6.63e-34) (mcalc-add-constant "hbar" 1.0552e-34) (defun mcalc-expand-candiate (string key) (if (< (length key) (length string)) nil (string-equal (substring key 0 (length string)) string))) ;; Returns a list : '(complete delta-string alternatives). (defun mcalc-expand-function (string) "Takes a partial function name as input, and returns a list (complete delta-string alt-string), where the elements are: complete: t if the entered string completely determines a function." (let ((function-alist) (ret-value) (exact-match-found) (common-string) (alternative-string)) (maphash '(lambda (key value) (if (string-equal key string) (setq exact-match-found 't)) (if (mcalc-expand-candiate string key) (push (cons key nil) function-alist))) mcalc-func-hash) (if function-alist (progn (dolist (e function-alist) (setq alternative-string (concat alternative-string (format "%s " (car e))))) (let ((completion (try-completion string function-alist))) (if (eq completion 't) (setq completion string)) (setq common-string (substring completion (length string)))) (when (string-equal common-string "") (setq common-string nil)))) ;;string possible completions case below action ;;-------------------------------------------------------------------------- ;;sqrt [sqrt] A Return with complete = true and call exit-minibuffer ;;si [sin,sinh] B Insert common substring "n" ;;sq [sqrt] B Insert unique substring "rt" ;;d [d,div,dup] C Return with a list of alternatives ;;g [] D Completely off - do nothin ;;-------------------------------------------------------------------------- (setq ret-value (cond ((and exact-match-found (= (length function-alist) 1)) (list 't nil nil)) ;; A (common-string (list nil common-string nil)) ;; B ((> (length function-alist) 0) (list nil nil alternative-string)) ;; C ( (list nil nil nil)))) ;; D ret-value)) (defun mcalc-goto-input-start () (search-backward "=>") (forward-char 2) (point)) (defun mcalc-get-current-string () (save-excursion (buffer-substring-no-properties (mcalc-goto-input-start) (point-max)))) (defun mcalc-clear-input () (mcalc-goto-input-start) (delete-region (point) (point-max))) (defun mcalc-is-first-character () (save-excursion (let ((current-point (mcalc-goto-input-start))) ;;(message "Sammenligner %s og %s" (point-max) current-point) (sleep-for 5) (if (= (point-max) current-point) 't nil)))) (defun mcalc-show-selection (alt-str) (message "Possible completions : <%s>" (substring alt-str 0 -1))) (defun mcalc-tab-function () (interactive) (let* ((current-string (mcalc-get-current-string)) (tmp (mcalc-expand-function current-string)) (complete (nth 0 tmp)) (add-str (nth 1 tmp)) (alt-str (nth 2 tmp))) (if add-str (insert add-str)) (if complete (exit-minibuffer)) (if alt-str (mcalc-show-selection alt-str)))) (defun mcalc-toggle-visual-sign () (let ((current-float (mcalc-string-to-float (mcalc-get-current-string)))) (if current-float (let ((new-float (mcalc-define-ch-sign current-float))) (mcalc-clear-input) (insert (format "%s" new-float))) (insert "-")))) ;; This code for adding/creating a keymap is heavily inspired by code ;; contributed by: Thomas Link (defun mcalc-make-keymap () (interactive) (let ((map (copy-keymap minibuffer-local-map)) (short-key-list) (key-list)) (maphash '(lambda (key value) (push key key-list) (when (= (length key) 1) (push key short-key-list))) mcalc-func-hash) (dolist (skey short-key-list) (let ((key-conflict)) (dolist (key key-list) (unless (string-equal key skey) (when (string-equal (substring key 0 1) skey) (setq key-conflict 't)))) (if (not key-conflict) (define-key map skey `(lambda () (interactive) (let ((first-char (mcalc-is-first-character))) (insert ,skey) (when first-char (exit-minibuffer)))))))) ;; The "-" causes some problems for the ability to enter negative numbers: ;; ;; Assume the stack looks like (5 2) =>, and you want add the negative ;; number -1 to the stack. Pressing "-" you immediately get evaluation of ;; (- 5 2), and the stack looks like (3) =>, which was clearly *not* what ;; you intended. To achieve the desired effect you can ;; ;; o Enter 1 and then subsequently "m" - which changes sign of the ;; last number on the stack. ;; ;; o Enter 1- , i.e. a digit first. ;; ;; I know - this is a bit awkward. (define-key map "-" `(lambda () (interactive) (if (mcalc-is-first-character) (progn (insert ,"-") (exit-minibuffer)) (mcalc-toggle-visual-sign)))) (define-key map " " 'exit-minibuffer) (define-key map [tab] 'mcalc-tab-function) map)) (defvar mcalc-keymap (mcalc-make-keymap) "Keymap for `mcalc'") (provide 'mcalc)