Mercurial > emacs
view lisp/calc/calc-fin.el @ 110523:a5ad4f188e19
Synch Semantic to CEDET 1.0.
Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog.
* semantic.el (semantic-version): Update to 2.0.
(semantic-mode-map): Add "," and "m" bindings.
(navigate-menu): Update.
* semantic/symref.el (semantic-symref-calculate-rootdir):
New function.
(semantic-symref-detect-symref-tool): Use it.
* semantic/symref/grep.el (semantic-symref-grep-shell): New var.
(semantic-symref-perform-search): Use it. Calculate root dir with
semantic-symref-calculate-rootdir.
(semantic-symref-derive-find-filepatterns): Improve error message.
* semantic/symref/list.el
(semantic-symref-results-mode-map): New bindings.
(semantic-symref-auto-expand-results): New option.
(semantic-symref-results-dump): Obey auto-expand.
(semantic-symref-list-expand-all, semantic-symref-regexp)
(semantic-symref-list-contract-all)
(semantic-symref-list-map-open-hits)
(semantic-symref-list-update-open-hits)
(semantic-symref-list-create-macro-on-open-hit)
(semantic-symref-list-call-macro-on-open-hits): New functions.
(semantic-symref-list-menu-entries)
(semantic-symref-list-menu): New vars.
(semantic-symref-list-map-open-hits): Move cursor to beginning of
match before calling the mapped function.
* semantic/doc.el
(semantic-documentation-comment-preceeding-tag): Do nothing if the
mode doesn't provide comment-start-skip.
* semantic/scope.el
(semantic-analyze-scope-nested-tags-default): Strip duplicates.
(semantic-analyze-scoped-inherited-tag-map): Take the tag we are
looking for as part of the scoped tags list.
* semantic/html.el (semantic-default-html-setup): Add
senator-step-at-tag-classes.
* semantic/decorate/include.el
(semantic-decoration-on-unknown-includes): Change light bgcolor.
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a postion.
* semantic/complete.el (semantic-collector-local-members):
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
* semantic/analyze/complete.el
(semantic-analyze-possible-completions-default): If no completions
are found, return the raw by-name-only completion list. Add FLAGS
arguments. Add support for 'no-tc (type constraint) and
'no-unique, or no stripping duplicates.
(semantic-analyze-possible-completions-default): Add FLAGS arg.
* semantic/util-modes.el
(semantic-stickyfunc-show-only-functions-p): New option.
(semantic-stickyfunc-fetch-stickyline): Don't show stickytext for
the very first line in a buffer.
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
(semantic-current-tag-interactive): Deleted.
(semantic-describe-buffer): Fix expand-nonterminal. Add
lex-syntax-mods, type relation separator char, and command
separation char.
(semantic-sanity-check): Only message if called interactively.
* semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the
:filename property and the tag position.
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Add recursion limit.
* semantic/imenu.el (semantic-imenu-bucketize-type-members):
Make this buffer local, not the obsoleted variable.
* semantic/idle.el: Add breadcrumbs support.
(semantic-idle-summary-current-symbol-info-default)
(semantic-idle-tag-highlight)
(semantic-idle-completion-list-default): Use
semanticdb-without-unloaded-file-searches for speed, and to
conform to the controls that specify if the idle timer is supposed
to be parsing unparsed includes.
(semantic-idle-symbol-highlight-face)
(semantic-idle-symbol-maybe-highlight): Rename from *-summary-*.
Callers changed.
(semantic-idle-work-parse-neighboring-files-flag): Default to nil.
(semantic-idle-work-update-headers-flag): New var.
(semantic-idle-work-for-one-buffer): Use it.
(semantic-idle-local-symbol-highlight): Rename from
semantic-idle-tag-highlight.
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
(semantic-ia-get-completions): Deleted. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
* semantic/grammar.el (semantic-grammar-create-package):
Save the buffer even in batch mode.
* semantic/fw.el
(semanticdb-without-unloaded-file-searches): New macro.
* semantic/dep.el (semantic-dependency-find-file-on-path):
Fix case dereferencing ede-object when it is a list.
* semantic/db-typecache.el (semanticdb-expand-nested-tag)
(semanticdb-typecache-faux-namespace): New functions.
(semanticdb-typecache-file-tags)
(semanticdb-typecache-merge-streams): Use them.
(semanticdb-typecache-file-tags): When deriving tags from a file,
give the mode a chance to monkey with the tag copy.
(semanticdb-typecache-find-default): Wrap find in save-excursion.
(semanticdb-typecache-find-by-name-helper): Merge found names down.
* semantic/db-global.el
(semanticdb-enable-gnu-global-in-buffer): Don't show messages if
GNU Global is not available and we don't want to throw an error.
* semantic/db-find.el (semanticdb-find-result-nth-in-buffer):
When trying to normalize the tag to a buffer, don't error if
set-buffer method doesn't exist.
* semantic/db-file.el (semanticdb-save-db): Simplify msg.
* semantic/db.el (semanticdb-refresh-table): If forcing a
refresh on a file not in a buffer, use semantic-find-file-noselect
and delete the buffer after use.
(semanticdb-current-database-list): When calculating root via
hooks, force it through true-filename and skip the list of
possible roots.
* semantic/ctxt.el (semantic-ctxt-imported-packages): New.
* semantic/analyze/debug.el
(semantic-analyzer-debug-insert-tag): Reset standard output to
current buffer.
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype): Change "prefix" to
"symbol" in messages.
* semantic/analyze/refs.el: (semantic-analyze-refs-impl)
(semantic-analyze-refs-proto): When calculating value, make sure
the found tag is 'similar' to the originating tag.
(semantic--analyze-refs-find-tags-with-parent): Attempt to
identify matches via imported symbols of parents.
(semantic--analyze-refs-full-lookup-with-parents): Do a deep
search during the brute search.
* semantic/analyze.el
(semantic-analyze-find-tag-sequence-default): Be robust to
calculated scopes being nil.
* semantic/bovine/c.el (semantic-c-describe-environment): Add
project macro symbol array.
(semantic-c-parse-lexical-token): Add recursion limit.
(semantic-ctxt-imported-packages, semanticdb-expand-nested-tag):
New overrides.
(semantic-expand-c-tag-namelist): Split a full type from a typedef
out to its own tag.
(semantic-expand-c-tag-namelist): Do not split out a typedef'd
inline type if it is an anonymous type.
(semantic-c-reconstitute-token): Use the optional initializers as
a clue that some function is probably a constructor. When
defining the type of these constructors, split the parent name,
and use only the class part, if applicable.
* semantic/bovine/c-by.el:
* semantic/wisent/python-wy.el: Regenerate.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 18 Sep 2010 22:49:54 -0400 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
line wrap: on
line source
;;; calc-fin.el --- financial functions for Calc ;; 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 <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; 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: ;;; Code: ;; This file is autoloaded from calc-ext.el. (require 'calc-ext) (require 'calc-macs) ;;; Financial functions. (defun calc-fin-pv () (interactive) (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3))) (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3))))))) (defun calc-fin-npv (arg) (interactive "p") (calc-slow-wrapper (if (calc-is-inverse) (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg)) (calc-vector-op "npv" 'calcFunc-npv (1+ arg))))) (defun calc-fin-fv () (interactive) (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3))) (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3))))))) (defun calc-fin-pmt () (interactive) (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3))) (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3))))))) (defun calc-fin-nper () (interactive) (calc-slow-wrapper (if (calc-is-hyperbolic) (calc-enter-result 3 "nprl" (cons 'calcFunc-nperl (calc-top-list-n 3))) (if (calc-is-inverse) (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb (calc-top-list-n 3))) (calc-enter-result 3 "nper" (cons 'calcFunc-nper (calc-top-list-n 3))))))) (defun calc-fin-rate () (interactive) (calc-slow-wrapper (calc-pop-push-record 3 (if (calc-is-hyperbolic) "ratl" (if (calc-is-inverse) "ratb" "rate")) (calc-to-percentage (calc-normalize (cons (if (calc-is-hyperbolic) 'calcFunc-ratel (if (calc-is-hyperbolic) 'calcFunc-rateb 'calcFunc-rate)) (calc-top-list-n 3))))))) (defun calc-fin-irr (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (calc-vector-op "irrb" 'calcFunc-irrb arg) (calc-vector-op "irr" 'calcFunc-irr arg)))) (defun calc-fin-sln () (interactive) (calc-slow-wrapper (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3))))) (defun calc-fin-syd () (interactive) (calc-slow-wrapper (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4))))) (defun calc-fin-ddb () (interactive) (calc-slow-wrapper (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4))))) (defun calc-to-percentage (x) (cond ((Math-objectp x) (setq x (math-mul x 100)) (if (Math-num-integerp x) (setq x (math-trunc x))) (list 'calcFunc-percent x)) ((Math-vectorp x) (cons 'vec (mapcar 'calc-to-percentage (cdr x)))) (t x))) (defun calc-convert-percent () (interactive) (calc-slow-wrapper (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1))))) (defun calc-percent-change () (interactive) (calc-slow-wrapper (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2))))) (calc-pop-push-record 2 "%ch" (calc-to-percentage res))))) ;;; Financial functions. (defun calcFunc-pv (rate num amount &optional lump) (math-check-financial rate num) (math-with-extra-prec 2 (let ((p (math-pow (math-add 1 rate) num))) (math-add (math-mul amount (math-div (math-sub 1 (math-div 1 p)) rate)) (math-div (or lump 0) p))))) (put 'calcFunc-pv 'math-expandable t) (defun calcFunc-pvl (rate num amount) (calcFunc-pv rate num 0 amount)) (put 'calcFunc-pvl 'math-expandable t) (defun calcFunc-pvb (rate num amount &optional lump) (math-check-financial rate num) (math-with-extra-prec 2 (let* ((p (math-pow (math-add 1 rate) num))) (math-add (math-mul amount (math-div (math-mul (math-sub 1 (math-div 1 p)) (math-add 1 rate)) rate)) (math-div (or lump 0) p))))) (put 'calcFunc-pvb 'math-expandable t) (defun calcFunc-npv (rate &rest flows) (math-check-financial rate 1) (math-with-extra-prec 2 (let* ((flat (math-flatten-many-vecs flows)) (pp (math-add 1 rate)) (p pp) (accum 0)) (while (setq flat (cdr flat)) (setq accum (math-add accum (math-div (car flat) p)) p (math-mul p pp))) accum))) (put 'calcFunc-npv 'math-expandable t) (defun calcFunc-npvb (rate &rest flows) (math-check-financial rate 1) (math-with-extra-prec 2 (let* ((flat (math-flatten-many-vecs flows)) (pp (math-add 1 rate)) (p 1) (accum 0)) (while (setq flat (cdr flat)) (setq accum (math-add accum (math-div (car flat) p)) p (math-mul p pp))) accum))) (put 'calcFunc-npvb 'math-expandable t) (defun calcFunc-fv (rate num amount &optional initial) (math-check-financial rate num) (math-with-extra-prec 2 (let ((p (math-pow (math-add 1 rate) num))) (math-add (math-mul amount (math-div (math-sub p 1) rate)) (math-mul (or initial 0) p))))) (put 'calcFunc-fv 'math-expandable t) (defun calcFunc-fvl (rate num amount) (calcFunc-fv rate num 0 amount)) (put 'calcFunc-fvl 'math-expandable t) (defun calcFunc-fvb (rate num amount &optional initial) (math-check-financial rate num) (math-with-extra-prec 2 (let ((p (math-pow (math-add 1 rate) num))) (math-add (math-mul amount (math-div (math-mul (math-sub p 1) (math-add 1 rate)) rate)) (math-mul (or initial 0) p))))) (put 'calcFunc-fvb 'math-expandable t) (defun calcFunc-pmt (rate num amount &optional lump) (math-check-financial rate num) (math-with-extra-prec 2 (let ((p (math-pow (math-add 1 rate) num))) (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate) (math-sub 1 (math-div 1 p)))))) (put 'calcFunc-pmt 'math-expandable t) (defun calcFunc-pmtb (rate num amount &optional lump) (math-check-financial rate num) (math-with-extra-prec 2 (let ((p (math-pow (math-add 1 rate) num))) (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate) (math-mul (math-sub 1 (math-div 1 p)) (math-add 1 rate)))))) (put 'calcFunc-pmtb 'math-expandable t) (defun calcFunc-nper (rate pmt amount &optional lump) (math-compute-nper rate pmt amount lump nil)) (put 'calcFunc-nper 'math-expandable t) (defun calcFunc-nperb (rate pmt amount &optional lump) (math-compute-nper rate pmt amount lump 'b)) (put 'calcFunc-nperb 'math-expandable t) (defun calcFunc-nperl (rate pmt amount) (math-compute-nper rate pmt amount nil 'l)) (put 'calcFunc-nperl 'math-expandable t) (defun math-compute-nper (rate pmt amount lump bflag) (and lump (math-zerop lump) (setq lump nil)) (and lump (math-zerop pmt) (setq amount lump lump nil bflag 'l)) (or (math-objectp rate) (and math-expand-formulas (null lump)) (math-reject-arg rate 'numberp)) (and (math-zerop rate) (math-reject-arg rate 'nonzerop)) (or (math-objectp pmt) (and math-expand-formulas (null lump)) (math-reject-arg pmt 'numberp)) (or (math-objectp amount) (and math-expand-formulas (null lump)) (math-reject-arg amount 'numberp)) (if lump (progn (or (math-objectp lump) (math-reject-arg lump 'numberp)) (let ((root (math-find-root (list 'calcFunc-eq (list (if bflag 'calcFunc-pvb 'calcFunc-pv) rate '(var DUMMY var-DUMMY) pmt lump) amount) '(var DUMMY var-DUMMY) '(intv 3 0 100) t))) (if (math-vectorp root) (nth 1 root) root))) (math-with-extra-prec 2 (let ((temp (if (eq bflag 'l) (math-div amount pmt) (math-sub 1 (math-div (math-mul amount rate) (if bflag (math-mul pmt (math-add 1 rate)) pmt)))))) (if (or (math-posp temp) math-expand-formulas) (math-neg (calcFunc-log temp (math-add 1 rate))) (math-reject-arg pmt "*Payment too small to cover interest rate")))))) (defun calcFunc-rate (num pmt amount &optional lump) (math-compute-rate num pmt amount lump 'calcFunc-pv)) (defun calcFunc-rateb (num pmt amount &optional lump) (math-compute-rate num pmt amount lump 'calcFunc-pvb)) (defun math-compute-rate (num pmt amount lump func) (or (math-objectp num) (math-reject-arg num 'numberp)) (or (math-objectp pmt) (math-reject-arg pmt 'numberp)) (or (math-objectp amount) (math-reject-arg amount 'numberp)) (or (null lump) (math-objectp lump) (math-reject-arg lump 'numberp)) (let ((root (math-find-root (list 'calcFunc-eq (list func '(var DUMMY var-DUMMY) num pmt (or lump 0)) amount) '(var DUMMY var-DUMMY) '(intv 3 (float 1 -4) 1) t))) (if (math-vectorp root) (nth 1 root) root))) (defun calcFunc-ratel (num pmt amount) (or (math-objectp num) math-expand-formulas (math-reject-arg num 'numberp)) (or (math-objectp pmt) math-expand-formulas (math-reject-arg pmt 'numberp)) (or (math-objectp amount) math-expand-formulas (math-reject-arg amount 'numberp)) (math-with-extra-prec 2 (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1))) (defun calcFunc-irr (&rest vecs) (math-compute-irr vecs 'calcFunc-npv)) (defun calcFunc-irrb (&rest vecs) (math-compute-irr vecs 'calcFunc-npvb)) (defun math-compute-irr (vecs func) (let* ((flat (math-flatten-many-vecs vecs)) (root (math-find-root (list func '(var DUMMY var-DUMMY) flat) '(var DUMMY var-DUMMY) '(intv 3 (float 1 -4) 1) t))) (if (math-vectorp root) (nth 1 root) root))) (defun math-check-financial (rate num) (or (math-objectp rate) math-expand-formulas (math-reject-arg rate 'numberp)) (and (math-zerop rate) (math-reject-arg rate 'nonzerop)) (or (math-objectp num) math-expand-formulas (math-reject-arg num 'numberp))) (defun calcFunc-sln (cost salvage life &optional period) (or (math-realp cost) math-expand-formulas (math-reject-arg cost 'realp)) (or (math-realp salvage) math-expand-formulas (math-reject-arg salvage 'realp)) (or (math-realp life) math-expand-formulas (math-reject-arg life 'realp)) (if (math-zerop life) (math-reject-arg life 'nonzerop)) (if (and period (if (math-num-integerp period) (or (Math-lessp life period) (not (math-posp period))) (math-reject-arg period 'integerp))) 0 (math-div (math-sub cost salvage) life))) (put 'calcFunc-sln 'math-expandable t) (defun calcFunc-syd (cost salvage life period) (or (math-realp cost) math-expand-formulas (math-reject-arg cost 'realp)) (or (math-realp salvage) math-expand-formulas (math-reject-arg salvage 'realp)) (or (math-realp life) math-expand-formulas (math-reject-arg life 'realp)) (if (math-zerop life) (math-reject-arg life 'nonzerop)) (or (math-realp period) math-expand-formulas (math-reject-arg period 'realp)) (if (or (Math-lessp life period) (not (math-posp period))) 0 (math-div (math-mul (math-sub cost salvage) (math-add (math-sub life period) 1)) (math-div (math-mul life (math-add life 1)) 2)))) (put 'calcFunc-syd 'math-expandable t) (defun calcFunc-ddb (cost salvage life period) (if (math-messy-integerp period) (setq period (math-trunc period))) (or (integerp period) (math-reject-arg period 'fixnump)) (or (math-realp cost) (math-reject-arg cost 'realp)) (or (math-realp salvage) (math-reject-arg salvage 'realp)) (or (math-realp life) (math-reject-arg life 'realp)) (if (math-zerop life) (math-reject-arg life 'nonzerop)) (if (or (Math-lessp life period) (<= period 0)) 0 (let ((book cost) (res 0)) (while (>= (setq period (1- period)) 0) (setq res (math-div (math-mul book 2) life) book (math-sub book res)) (if (Math-lessp book salvage) (setq res (math-add res (math-sub book salvage)) book salvage))) res))) (provide 'calc-fin) ;; arch-tag: 82f30ca8-d02f-4b33-84b4-bb6ecd84597b ;;; calc-fin.el ends here