New major mode "SES" for spreadsheets.
New function (unsafep X) determines whether X is a safe Lisp form. New support module testcover.el for coverage testing.
This commit is contained in:
Jonathan Yavner
parent
6209bd8c0a
commit
7ed9159a5c
16 changed files with 5722 additions and 24 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2002-09-16 Jonathan Yavner <jyavner@engineer.com>
|
||||
|
||||
* ses-example.ses: New file: example spreadsheet.
|
||||
|
||||
2002-09-04 Kenichi Handa <handa@etl.go.jp>
|
||||
|
||||
* HELLO: Fix Unicode Greek line.
|
||||
|
|
|
|||
207
etc/ses-example.ses
Normal file
207
etc/ses-example.ses
Normal file
|
|
@ -0,0 +1,207 @@
|
|||
Sales summary - Acme fundraising
|
||||
|
||||
~~~~~~~~~~~~~Summary~~~~~~~~~~~~~
|
||||
--Totals-- Average
|
||||
Eastern-area $46.70 2 $23.35
|
||||
West-district $80.25 10 $8.03
|
||||
North&South $99.69 5 $19.94
|
||||
TOTAL ~$227 17 $13.33
|
||||
|
||||
= = = = = =Details = = = = = =
|
||||
99/07/25 North&South $40.00
|
||||
99/08/16 West-district $5.25
|
||||
99/08/16 North&South $12.99
|
||||
99/08/25 West-district $8.61
|
||||
99/08/26 West-district $9.97
|
||||
99/09/04 Eastern-area $21.00
|
||||
00/01/15 West-district $5.50
|
||||
00/07/15 West-district $19.01
|
||||
00/07/26 North&South $27.95
|
||||
00/08/04 West-district $11.71
|
||||
00/08/16 Eastern-area $25.70
|
||||
00/08/25 West-district $4.95
|
||||
00/08/26 West-district $7.21
|
||||
00/09/01 North&South $1.25
|
||||
01/07/25 West-district $5.75
|
||||
01/08/04 West-district $2.29
|
||||
01/08/15 North&South $17.50
|
||||
|
||||
|
||||
(ses-cell A1 "Sales summary - Acme fundraising" "Sales summary - Acme fundraising" nil nil)
|
||||
(ses-cell B1 *skip* nil nil nil)
|
||||
(ses-cell C1 *skip* nil nil nil)
|
||||
(ses-cell D1 *skip* nil nil nil)
|
||||
(ses-cell E1 nil nil nil nil)
|
||||
|
||||
(ses-cell A2 nil nil nil nil)
|
||||
(ses-cell B2 nil nil nil nil)
|
||||
(ses-cell C2 nil nil nil nil)
|
||||
(ses-cell D2 nil nil nil nil)
|
||||
(ses-cell E2 nil nil nil nil)
|
||||
|
||||
(ses-cell A3 nil nil nil nil)
|
||||
(ses-cell B3 "Summary" "Summary" ses-tildefill-span nil)
|
||||
(ses-cell C3 *skip* nil nil nil)
|
||||
(ses-cell D3 *skip* nil nil nil)
|
||||
(ses-cell E3 *skip* nil nil nil)
|
||||
|
||||
(ses-cell A4 nil nil nil nil)
|
||||
(ses-cell B4 nil nil nil nil)
|
||||
(ses-cell C4 "Totals" "Totals" ses-dashfill-span nil)
|
||||
(ses-cell D4 *skip* nil nil nil)
|
||||
(ses-cell E4 "Average" "Average" nil nil)
|
||||
|
||||
(ses-cell A5 nil nil nil nil)
|
||||
(ses-cell B5 Eastern-area (quote Eastern-area) nil nil)
|
||||
(ses-cell C5 46.7 (apply (quote +) (ses-select (ses-range B11 B27) (quote Eastern-area) (ses-range C11 C27))) nil (C8 E5))
|
||||
(ses-cell D5 2 (length (ses-select (ses-range B11 B27) (quote Eastern-area) (ses-range C11 C27))) nil (D8 E5))
|
||||
(ses-cell E5 23.35 (/ C5 D5) nil nil)
|
||||
|
||||
(ses-cell A6 nil nil nil nil)
|
||||
(ses-cell B6 West-district (quote West-district) nil nil)
|
||||
(ses-cell C6 80.25 (apply (quote +) (ses-select (ses-range B11 B27) (quote West-district) (ses-range C11 C27))) nil (C8 E6))
|
||||
(ses-cell D6 10 (length (ses-select (ses-range B11 B27) (quote West-district) (ses-range C11 C27))) nil (D8 E6))
|
||||
(ses-cell E6 8.025 (/ C6 D6) nil nil)
|
||||
|
||||
(ses-cell A7 nil nil nil nil)
|
||||
(ses-cell B7 North&South (quote North&South) nil nil)
|
||||
(ses-cell C7 99.69 (apply (quote +) (ses-select (ses-range B11 B27) (quote North&South) (ses-range C11 C27))) nil (C8 E7))
|
||||
(ses-cell D7 5 (length (ses-select (ses-range B11 B27) (quote North&South) (ses-range C11 C27))) nil (D8 E7))
|
||||
(ses-cell E7 19.938 (/ C7 D7) nil nil)
|
||||
|
||||
(ses-cell A8 nil nil nil nil)
|
||||
(ses-cell B8 "TOTAL" "TOTAL" nil nil)
|
||||
(ses-cell C8 226.64 (ses+ C5 C6 C7) "~$%.0f" (E8))
|
||||
(ses-cell D8 17 (ses+ D5 D6 D7) nil (E8))
|
||||
(ses-cell E8 13.331764705882351 (/ C8 D8) nil nil)
|
||||
|
||||
(ses-cell A9 nil nil ses-center nil)
|
||||
(ses-cell B9 useless (quote useless) (lambda (x) (if (eq x (quote useless)) "" (prin1-to-string x))) nil)
|
||||
(ses-cell C9 nil nil nil nil)
|
||||
(ses-cell D9 nil nil nil nil)
|
||||
(ses-cell E9 nil nil nil nil)
|
||||
|
||||
(ses-cell A10 "Details " "Details " (lambda (x) (replace-regexp-in-string "==" "= " (ses-center-span x 61))) nil)
|
||||
(ses-cell B10 *skip* nil nil nil)
|
||||
(ses-cell C10 *skip* nil nil nil)
|
||||
(ses-cell D10 "" "" nil nil)
|
||||
(ses-cell E10 nil nil nil nil)
|
||||
|
||||
(ses-cell A11 990725 990725 nil nil)
|
||||
(ses-cell B11 North&South (quote North&South) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C11 40 40 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D11 nil nil nil nil)
|
||||
(ses-cell E11 nil nil nil nil)
|
||||
|
||||
(ses-cell A12 990816 990816 nil nil)
|
||||
(ses-cell B12 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C12 5.25 5.25 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D12 nil nil nil nil)
|
||||
(ses-cell E12 nil nil nil nil)
|
||||
|
||||
(ses-cell A13 990816 990816 nil nil)
|
||||
(ses-cell B13 North&South (quote North&South) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C13 12.99 12.99 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D13 nil nil nil nil)
|
||||
(ses-cell E13 nil nil nil nil)
|
||||
|
||||
(ses-cell A14 990825 990825 nil nil)
|
||||
(ses-cell B14 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C14 8.61 8.61 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D14 nil nil nil nil)
|
||||
(ses-cell E14 nil nil nil nil)
|
||||
|
||||
(ses-cell A15 990826 990826 nil nil)
|
||||
(ses-cell B15 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C15 9.97 9.97 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D15 nil nil nil nil)
|
||||
(ses-cell E15 nil nil nil nil)
|
||||
|
||||
(ses-cell A16 990904 990904 nil nil)
|
||||
(ses-cell B16 Eastern-area (quote Eastern-area) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C16 21 (/ life-universe-everything 2) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D16 nil nil nil nil)
|
||||
(ses-cell E16 nil nil nil nil)
|
||||
|
||||
(ses-cell A17 115 115 nil nil)
|
||||
(ses-cell B17 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C17 5.5 5.5 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D17 nil nil nil nil)
|
||||
(ses-cell E17 nil nil nil nil)
|
||||
|
||||
(ses-cell A18 715 715 nil nil)
|
||||
(ses-cell B18 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C18 19.01 19.01 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D18 nil nil nil nil)
|
||||
(ses-cell E18 nil nil nil nil)
|
||||
|
||||
(ses-cell A19 726 726 nil nil)
|
||||
(ses-cell B19 North&South (quote North&South) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C19 27.95 27.95 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D19 nil nil nil nil)
|
||||
(ses-cell E19 nil nil nil nil)
|
||||
|
||||
(ses-cell A20 804 804 nil nil)
|
||||
(ses-cell B20 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C20 11.71 11.71 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D20 nil nil nil nil)
|
||||
(ses-cell E20 nil nil nil nil)
|
||||
|
||||
(ses-cell A21 816 816 nil nil)
|
||||
(ses-cell B21 Eastern-area (quote Eastern-area) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C21 25.7 25.7 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D21 nil nil nil nil)
|
||||
(ses-cell E21 nil nil nil nil)
|
||||
|
||||
(ses-cell A22 825 825 nil nil)
|
||||
(ses-cell B22 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C22 4.95 4.95 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D22 nil nil nil nil)
|
||||
(ses-cell E22 nil nil nil nil)
|
||||
|
||||
(ses-cell A23 826 826 nil nil)
|
||||
(ses-cell B23 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C23 7.21 7.21 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D23 nil nil nil nil)
|
||||
(ses-cell E23 nil nil nil nil)
|
||||
|
||||
(ses-cell A24 901 901 nil nil)
|
||||
(ses-cell B24 North&South (quote North&South) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C24 1.25 1.25 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D24 nil nil nil nil)
|
||||
(ses-cell E24 nil nil nil nil)
|
||||
|
||||
(ses-cell A25 10725 10725 nil nil)
|
||||
(ses-cell B25 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C25 5.75 5.75 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D25 nil nil nil nil)
|
||||
(ses-cell E25 nil nil nil nil)
|
||||
|
||||
(ses-cell A26 10804 10804 nil nil)
|
||||
(ses-cell B26 West-district (quote West-district) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C26 2.29 2.29 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D26 nil nil nil nil)
|
||||
(ses-cell E26 nil nil nil nil)
|
||||
|
||||
(ses-cell A27 10815 10815 nil nil)
|
||||
(ses-cell B27 North&South (quote North&South) nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell C27 17.5 17.5 nil (D7 C7 D6 C6 D5 C5))
|
||||
(ses-cell D27 nil nil nil nil)
|
||||
(ses-cell E27 nil nil nil nil)
|
||||
|
||||
(ses-column-widths [8 14 6 3 7])
|
||||
(ses-column-printers [(lambda (x) (format "%02d/%02d/%02d" (/ x 10000) (% (/ x 100) 100) (% x 100))) ("%s") "$%.2f" nil "$%.2f"])
|
||||
(ses-default-printer "%.7g")
|
||||
(ses-header-row 0)
|
||||
|
||||
( ;Global parameters (these are read first)
|
||||
2 ;SES file-format
|
||||
27 ;numrows
|
||||
5 ;numcols
|
||||
)
|
||||
|
||||
;;; Local Variables:
|
||||
;;; mode: ses
|
||||
;;; life-universe-everything: 42
|
||||
;;; symbolic-formulas: (("Eastern area") ("West-district") ("North&South") ("Other"))
|
||||
;;; End:
|
||||
|
|
@ -895,6 +895,17 @@
|
|||
|
||||
* viper.el (viper-emacs-state-mode-list): Added modes.
|
||||
|
||||
2002-09-18 Jonathan Yavner <jyavner@engineer.com>
|
||||
|
||||
* emacs-lisp/testcover.el: New file. Uses edebug to instrument a
|
||||
module of code, with graphical display of poor-coverage spots.
|
||||
|
||||
* emacs-lisp/testcover-ses.el: New file. Demonstrates use of
|
||||
testcover on a interactive module like ses.
|
||||
|
||||
* emacs-lisp/testcover-unsafep.el: New file. Demonstrates use of
|
||||
testcover on a noninteractive module like unsafep.
|
||||
|
||||
2002-09-18 Miles Bader <miles@gnu.org>
|
||||
|
||||
* diff-mode.el (diff-mode): Don't evaluate `compilation-last-buffer'
|
||||
|
|
@ -909,6 +920,21 @@
|
|||
Don't output the C-x # message if `nowait'.
|
||||
(server-buffer-done): Use server-log's new arg.
|
||||
|
||||
2002-09-16 Jonathan Yavner <jyavner@engineer.com>
|
||||
|
||||
* ses.el: New file.
|
||||
|
||||
* emacs-lisp/unsafep.el: New file.
|
||||
|
||||
* files.el (auto-mode-alist): Add ".ses" for ses-mode.
|
||||
(inhibit-quit): This is risky for unsafep, doesn't matter much for
|
||||
anybody else.
|
||||
(risky-local-variable-p): New function. Split off from
|
||||
hack-one-local-variable so unsafep can use it. Add \|-history$ to
|
||||
the list of disallowed local variable names (malicious user could
|
||||
stuff a `display' property in there that would be activated when
|
||||
na,Ao(Bve user called up the history).
|
||||
|
||||
2002-09-16 Markus Rost <rost@math.ohio-state.edu>
|
||||
|
||||
* ls-lisp.el (ls-lisp-format-time-list): Fix type and provide :tag's.
|
||||
|
|
|
|||
|
|
@ -37,8 +37,8 @@
|
|||
(put 'ps-print-vertical 'custom-loads '("ps-print"))
|
||||
(put 'supercite-hooks 'custom-loads '("supercite"))
|
||||
(put 'vhdl-menu 'custom-loads '("vhdl-mode"))
|
||||
(put 'chinese-calendar 'custom-loads '("cal-china"))
|
||||
(put 'gnus-newsrc 'custom-loads '("gnus-start"))
|
||||
(put 'chinese-calendar 'custom-loads '("cal-china"))
|
||||
(put 'expand 'custom-loads '("expand"))
|
||||
(put 'bookmark 'custom-loads '("bookmark"))
|
||||
(put 'icon 'custom-loads '("icon"))
|
||||
|
|
@ -221,8 +221,8 @@
|
|||
(put 'auto-save 'custom-loads '("files" "startup"))
|
||||
(put 'tpu 'custom-loads '("tpu-edt" "tpu-extras"))
|
||||
(put 'w32 'custom-loads '("w32-vars"))
|
||||
(put 'viper-hooks 'custom-loads '("viper-init"))
|
||||
(put 'gnus-cite 'custom-loads '("gnus-cite"))
|
||||
(put 'viper-hooks 'custom-loads '("viper-init"))
|
||||
(put 'gnus-demon 'custom-loads '("gnus-demon"))
|
||||
(put 'reftex-optimizations-for-large-documents 'custom-loads '("reftex-vars"))
|
||||
(put 'viper-misc 'custom-loads '("viper-cmd" "viper-init" "viper"))
|
||||
|
|
@ -265,18 +265,20 @@
|
|||
(put 'ps-print 'custom-loads '("ps-print"))
|
||||
(put 'view 'custom-loads '("view" "calendar"))
|
||||
(put 'cwarn 'custom-loads '("cwarn"))
|
||||
(put 'testcover 'custom-loads '("testcover"))
|
||||
(put 'gnus-score-default 'custom-loads '("gnus-score" "gnus-sum"))
|
||||
(put 'ebnf-except 'custom-loads '("ebnf2ps"))
|
||||
(put 'nnmail-duplicate 'custom-loads '("nnmail"))
|
||||
(put 'handwrite 'custom-loads '("handwrite"))
|
||||
(put 'tags 'custom-loads '("speedbar"))
|
||||
(put 'ses 'custom-loads '("ses"))
|
||||
(put 'eshell-proc 'custom-loads '("esh-proc"))
|
||||
(put 'custom-browse 'custom-loads '("cus-edit"))
|
||||
(put 'mime 'custom-loads '("mailcap" "mm-bodies"))
|
||||
(put 'generic-x 'custom-loads '("generic-x"))
|
||||
(put 'partial-completion 'custom-loads '("complete"))
|
||||
(put 'whitespace 'custom-loads '("whitespace"))
|
||||
(put 'maint 'custom-loads '("emacsbug" "gulp" "lisp-mnt"))
|
||||
(put 'maint 'custom-loads '("gulp" "lisp-mnt" "emacsbug"))
|
||||
(put 'pages 'custom-loads '("page-ext"))
|
||||
(put 'message-interface 'custom-loads '("message"))
|
||||
(put 'diary 'custom-loads '("calendar" "diary-lib" "solar"))
|
||||
|
|
@ -374,8 +376,8 @@
|
|||
(put 'log-view 'custom-loads '("log-view"))
|
||||
(put 'PostScript 'custom-loads '("ps-mode"))
|
||||
(put 'abbrev-mode 'custom-loads '("abbrev" "cus-edit" "mailabbrev"))
|
||||
(put 'eshell-term 'custom-loads '("em-term"))
|
||||
(put 'earcon 'custom-loads '("earcon"))
|
||||
(put 'eshell-term 'custom-loads '("em-term"))
|
||||
(put 'feedmail-headers 'custom-loads '("feedmail"))
|
||||
(put 'hypermedia 'custom-loads '("wid-edit" "metamail" "browse-url" "goto-addr"))
|
||||
(put 'image 'custom-loads '("image-file"))
|
||||
|
|
@ -466,14 +468,14 @@
|
|||
(put 'bibtex 'custom-loads '("bibtex"))
|
||||
(put 'faces 'custom-loads '("faces" "loaddefs" "facemenu" "cus-edit" "font-lock" "hilit-chg" "paren" "ps-print" "speedbar" "time" "whitespace" "wid-edit" "woman" "gnus" "message" "cwarn" "make-mode"))
|
||||
(put 'gnus-summary-various 'custom-loads '("gnus-sum"))
|
||||
(put 'applications 'custom-loads '("calendar" "cus-edit" "uniquify" "eshell" "spell"))
|
||||
(put 'applications 'custom-loads '("calendar" "cus-edit" "ses" "uniquify" "eshell" "spell"))
|
||||
(put 'ebrowse-member 'custom-loads '("ebrowse"))
|
||||
(put 'terminal 'custom-loads '("terminal"))
|
||||
(put 'shadow 'custom-loads '("shadowfile" "shadow"))
|
||||
(put 'hl-line 'custom-loads '("hl-line"))
|
||||
(put 'eshell-glob 'custom-loads '("em-glob"))
|
||||
(put 'internal 'custom-loads '("startup" "cus-edit" "delim-col"))
|
||||
(put 'lisp 'custom-loads '("simple" "lisp" "lisp-mode" "ielm" "xscheme" "advice" "bytecomp" "checkdoc" "cl-indent" "cust-print" "edebug" "eldoc" "elp" "find-func" "pp" "re-builder" "shadow" "trace" "scheme"))
|
||||
(put 'lisp 'custom-loads '("simple" "lisp" "lisp-mode" "ielm" "unsafep" "xscheme" "advice" "bytecomp" "checkdoc" "cl-indent" "cust-print" "edebug" "eldoc" "elp" "find-func" "pp" "re-builder" "shadow" "testcover" "trace" "scheme"))
|
||||
(put 'local 'custom-loads '("calendar"))
|
||||
(put 'rlogin 'custom-loads '("rlogin"))
|
||||
(put 'debugger 'custom-loads '("debug"))
|
||||
|
|
@ -848,10 +850,14 @@ as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>.")
|
|||
(custom-put-if-not 'sql-db2-options 'standard-value t)
|
||||
(custom-put-if-not 'cwarn 'custom-version "21.1")
|
||||
(custom-put-if-not 'cwarn 'group-documentation "Highlight suspicious C and C++ constructions.")
|
||||
(custom-put-if-not 'testcover 'custom-version "21.1")
|
||||
(custom-put-if-not 'testcover 'group-documentation "Code-coverage tester")
|
||||
(custom-put-if-not 'sgml-xml-mode 'custom-version "21.4")
|
||||
(custom-put-if-not 'sgml-xml-mode 'standard-value t)
|
||||
(custom-put-if-not 'message-buffer-naming-style 'custom-version "21.1")
|
||||
(custom-put-if-not 'message-buffer-naming-style 'standard-value t)
|
||||
(custom-put-if-not 'ses 'custom-version "21.1")
|
||||
(custom-put-if-not 'ses 'group-documentation "Simple Emacs Spreadsheet")
|
||||
(custom-put-if-not 'ps-footer-font-size 'custom-version "21.1")
|
||||
(custom-put-if-not 'ps-footer-font-size 'standard-value t)
|
||||
(custom-put-if-not 'hscroll-margin 'custom-version "21.3")
|
||||
|
|
@ -872,10 +878,10 @@ as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>.")
|
|||
(custom-put-if-not 'vc-diff-switches 'standard-value t)
|
||||
(custom-put-if-not 'vcursor-interpret-input 'custom-version "20.3")
|
||||
(custom-put-if-not 'vcursor-interpret-input 'standard-value t)
|
||||
(custom-put-if-not 'diary-sabbath-candles-minutes 'custom-version "21.1")
|
||||
(custom-put-if-not 'diary-sabbath-candles-minutes 'standard-value t)
|
||||
(custom-put-if-not 'gnus-audio 'custom-version "21.1")
|
||||
(custom-put-if-not 'gnus-audio 'group-documentation "Playing sound in Gnus.")
|
||||
(custom-put-if-not 'diary-sabbath-candles-minutes 'custom-version "21.1")
|
||||
(custom-put-if-not 'diary-sabbath-candles-minutes 'standard-value t)
|
||||
(custom-put-if-not 'trailing-whitespace 'custom-version "21.1")
|
||||
(custom-put-if-not 'trailing-whitespace 'group-documentation nil)
|
||||
(custom-put-if-not 'fortran-comment-line-start 'custom-version "21.1")
|
||||
|
|
|
|||
711
lisp/emacs-lisp/testcover-ses.el
Normal file
711
lisp/emacs-lisp/testcover-ses.el
Normal file
|
|
@ -0,0 +1,711 @@
|
|||
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
|
||||
|
||||
;; Copyright (C) 2002 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Keywords: spreadsheet lisp utility
|
||||
|
||||
;; 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 2, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
(require 'testcover)
|
||||
|
||||
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
|
||||
;;;macros to pause after each step.
|
||||
(let* ((pause nil)
|
||||
(x (if pause "q" ""))
|
||||
(y "ses-test.ses\r<"))
|
||||
;;Fiddle with the existing spreadsheet
|
||||
(fset 'ses-exercise-example
|
||||
(concat "" data-directory "ses-example.ses\r<"
|
||||
x "10"
|
||||
x " "
|
||||
x " "
|
||||
x "pses-center\r"
|
||||
x "p\r"
|
||||
x "\t\t"
|
||||
x "\r A9 B9\r"
|
||||
x ""
|
||||
x "\r 2\r"
|
||||
x ""
|
||||
x "50\r"
|
||||
x "4 "
|
||||
x " "
|
||||
x " "
|
||||
x "(+ o\0"
|
||||
x "-1o \r"
|
||||
x " "
|
||||
x))
|
||||
;;Create a new spreadsheet
|
||||
(fset 'ses-exercise-new
|
||||
(concat y
|
||||
x "\"%.8g\"\r"
|
||||
x "2\r"
|
||||
x ""
|
||||
x ""
|
||||
x "2"
|
||||
x "\"Header\r"
|
||||
x "(sqrt 1\r"
|
||||
x "pses-center\r"
|
||||
x "\t"
|
||||
x "(+ A2 A3\r"
|
||||
x "(* B2 A3\r"
|
||||
x "2"
|
||||
x "\rB3\r"
|
||||
x ""
|
||||
x))
|
||||
;;Basic cell display
|
||||
(fset 'ses-exercise-display
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x ""
|
||||
x "\"Very long\r"
|
||||
x "w3\r"
|
||||
x "w3\r"
|
||||
x "(/ 1 0\r"
|
||||
x "234567\r"
|
||||
x "5w"
|
||||
x "\t1\r"
|
||||
x ""
|
||||
x "234567\r"
|
||||
x "\t"
|
||||
x ""
|
||||
x "345678\r"
|
||||
x "3w"
|
||||
x "\0>"
|
||||
x ""
|
||||
x ""
|
||||
x ""
|
||||
x ""
|
||||
x ""
|
||||
x ""
|
||||
x ""
|
||||
x "1\r"
|
||||
x ""
|
||||
x ""
|
||||
x "\"1234567-1234567-1234567\r"
|
||||
x "123\r"
|
||||
x "2"
|
||||
x "\"1234567-1234567-1234567\r"
|
||||
x "123\r"
|
||||
x "w8\r"
|
||||
x "\"1234567\r"
|
||||
x "w5\r"
|
||||
x))
|
||||
;;Cell formulas
|
||||
(fset 'ses-exercise-formulas
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "\t\t"
|
||||
x "\t"
|
||||
x "(* B1 B2 D1\r"
|
||||
x "(* B2 B3\r"
|
||||
x "(apply '+ (ses-range B1 B3)\r"
|
||||
x "(apply 'ses+ (ses-range B1 B3)\r"
|
||||
x "(apply 'ses+ (ses-range A2 A3)\r"
|
||||
x "(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r"
|
||||
x "(apply 'concat (reverse (ses-range A3 D3))\r"
|
||||
x "(* (+ A2 A3) (ses+ B2 B3)\r"
|
||||
x ""
|
||||
x "2"
|
||||
x "5\t"
|
||||
x "(apply 'ses+ (ses-range E1 E2)\r"
|
||||
x "(apply 'ses+ (ses-range A5 B5)\r"
|
||||
x "(apply 'ses+ (ses-range E1 F1)\r"
|
||||
x "(apply 'ses+ (ses-range D1 E1)\r"
|
||||
x "\t"
|
||||
x "(ses-average (ses-range A2 A5)\r"
|
||||
x "(apply 'ses+ (ses-range A5 A6)\r"
|
||||
x "k"
|
||||
x " "
|
||||
x ""
|
||||
x "2"
|
||||
x "3 "
|
||||
x "o"
|
||||
x "2o"
|
||||
x "3k"
|
||||
x "(ses-average (ses-range B3 E3)\r"
|
||||
x "k"
|
||||
x "12345678\r"
|
||||
x))
|
||||
;;Recalculating and reconstructing
|
||||
(fset 'ses-exercise-recalc
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x " "
|
||||
x "\t\t"
|
||||
x ""
|
||||
x "(/ 1 0\r"
|
||||
x ""
|
||||
x "\n"
|
||||
x ""
|
||||
x "\"%.6g\"\r"
|
||||
x " "
|
||||
x ">nw"
|
||||
x "\0>xdelete-region\r"
|
||||
x " "
|
||||
x "8"
|
||||
x "\0>xdelete-region\r"
|
||||
x " "
|
||||
x ""
|
||||
x " k"
|
||||
x " "
|
||||
x "\"Very long\r"
|
||||
x ""
|
||||
x "\r\r"
|
||||
x ""
|
||||
x "o"
|
||||
x ""
|
||||
x "\"Very long2\r"
|
||||
x "o"
|
||||
x ""
|
||||
x "\rC3\r"
|
||||
x "\rC2\r"
|
||||
x "\0"
|
||||
x "\rC4\r"
|
||||
x "\rC2\r"
|
||||
x "\0"
|
||||
x ""
|
||||
x "xses-mode\r"
|
||||
x "<"
|
||||
x "2k"
|
||||
x))
|
||||
;;Header line
|
||||
(fset 'ses-exercise-header-row
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "<"
|
||||
x ">"
|
||||
x "6<"
|
||||
x ">"
|
||||
x "7<"
|
||||
x ">"
|
||||
x "8<"
|
||||
x "2<"
|
||||
x ">"
|
||||
x "3w"
|
||||
x "10<"
|
||||
x ">"
|
||||
x "2 "
|
||||
x))
|
||||
;;Detecting unsafe formulas and printers
|
||||
(fset 'ses-exercise-unsafe
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "p(lambda (x) (delete-file x))\rn"
|
||||
x "p(lambda (x) (delete-file \"ses-nothing\"))\ry"
|
||||
x "\0n"
|
||||
x "(delete-file \"x\"\rn"
|
||||
x "(delete-file \"ses-nothing\"\ry"
|
||||
x "\0n"
|
||||
x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry"
|
||||
x "\0n"
|
||||
x))
|
||||
;;Inserting and deleting rows
|
||||
(fset 'ses-exercise-rows
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x ""
|
||||
x "\"%s=\"\r"
|
||||
x "20"
|
||||
x "p\"%s+\"\r"
|
||||
x ""
|
||||
x "123456789\r"
|
||||
x "\021"
|
||||
x ""
|
||||
x " "
|
||||
x "(not B25\r"
|
||||
x "k"
|
||||
x "jA3\r"
|
||||
x "19 "
|
||||
x " "
|
||||
x "100" ;Make this approx your CPU speed in MHz
|
||||
x))
|
||||
;;Inserting and deleting columns
|
||||
(fset 'ses-exercise-columns
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "\"%s@\"\r"
|
||||
x "o"
|
||||
x ""
|
||||
x "o"
|
||||
x " "
|
||||
x "k"
|
||||
x "w8\r"
|
||||
x "p\"%.7s*\"\r"
|
||||
x "o"
|
||||
x ""
|
||||
x "2o"
|
||||
x "3k"
|
||||
x "\"%.6g\"\r"
|
||||
x "26o"
|
||||
x "\026\t"
|
||||
x "26o"
|
||||
x "0\r"
|
||||
x "26\t"
|
||||
x "400"
|
||||
x "50k"
|
||||
x "\0D"
|
||||
x))
|
||||
(fset 'ses-exercise-editing
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "1\r"
|
||||
x "('x\r"
|
||||
x ""
|
||||
x " "
|
||||
x "\r\r"
|
||||
x "w9\r"
|
||||
x "\r.5\r"
|
||||
x "\r 10\r"
|
||||
x "w12\r"
|
||||
x "\r'\r"
|
||||
x "\r\r"
|
||||
x "jA4\r"
|
||||
x "(+ A2 100\r"
|
||||
x "3\r"
|
||||
x "jB1\r"
|
||||
x "(not A1\r"
|
||||
x "\"Very long\r"
|
||||
x ""
|
||||
x "h"
|
||||
x "H"
|
||||
x ""
|
||||
x ">\t"
|
||||
x ""
|
||||
x ""
|
||||
x "2"
|
||||
x ""
|
||||
x "o"
|
||||
x "h"
|
||||
x "\0"
|
||||
x "\"Also very long\r"
|
||||
x "H"
|
||||
x "\0'\r"
|
||||
x "'Trial\r"
|
||||
x "'qwerty\r"
|
||||
x "(concat o<\0"
|
||||
x "-1o\r"
|
||||
x "(apply '+ o<\0-1o\r"
|
||||
x "2"
|
||||
x "-2"
|
||||
x "-2"
|
||||
x "2"
|
||||
x " "
|
||||
x "H"
|
||||
x "\0"
|
||||
x "\"Another long one\r"
|
||||
x "H"
|
||||
x ""
|
||||
x "<"
|
||||
x ""
|
||||
x ">"
|
||||
x "\0"
|
||||
x))
|
||||
;;Sorting of columns
|
||||
(fset 'ses-exercise-sort-column
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "\"Very long\r"
|
||||
x "99\r"
|
||||
x "o13\r"
|
||||
x "(+ A3 B3\r"
|
||||
x "7\r8\r(* A4 B4\r"
|
||||
x "\0A\r"
|
||||
x "\0B\r"
|
||||
x "\0C\r"
|
||||
x "o"
|
||||
x "\0C\r"
|
||||
x))
|
||||
;;Simple cell printers
|
||||
(fset 'ses-exercise-cell-printers
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "\"4\t76\r"
|
||||
x "\"4\n7\r"
|
||||
x "p\"{%S}\"\r"
|
||||
x "p(\"[%s]\")\r"
|
||||
x "p(\"<%s>\")\r"
|
||||
x "\0"
|
||||
x "p\r"
|
||||
x "pnil\r"
|
||||
x "pses-dashfill\r"
|
||||
x "48\r"
|
||||
x "\t"
|
||||
x "\0p\r"
|
||||
x "p\r"
|
||||
x "pses-dashfill\r"
|
||||
x "\0pnil\r"
|
||||
x "5\r"
|
||||
x "pses-center\r"
|
||||
x "\"%s\"\r"
|
||||
x "w8\r"
|
||||
x "p\r"
|
||||
x "p\"%.7g@\"\r"
|
||||
x "\r"
|
||||
x "\"%.6g#\"\r"
|
||||
x "\"%.6g.\"\r"
|
||||
x "\"%.6g.\"\r"
|
||||
x "pidentity\r"
|
||||
x "6\r"
|
||||
x "\"UPCASE\r"
|
||||
x "pdowncase\r"
|
||||
x "(* 3 4\r"
|
||||
x "p(lambda (x) '(\"Hi\"))\r"
|
||||
x "p(lambda (x) '(\"Bye\"))\r"
|
||||
x))
|
||||
;;Spanning cell printers
|
||||
(fset 'ses-exercise-spanning-printers
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "p\"%.6g*\"\r"
|
||||
x "pses-dashfill-span\r"
|
||||
x "5\r"
|
||||
x "pses-tildefill-span\r"
|
||||
x "\"4\r"
|
||||
x "p\"$%s\"\r"
|
||||
x "p(\"$%s\")\r"
|
||||
x "8\r"
|
||||
x "p(\"!%s!\")\r"
|
||||
x "\t\"12345678\r"
|
||||
x "pses-dashfill-span\r"
|
||||
x "\"23456789\r"
|
||||
x "\t"
|
||||
x "(not t\r"
|
||||
x "w6\r"
|
||||
x "\"5\r"
|
||||
x "o"
|
||||
x "k"
|
||||
x "k"
|
||||
x "\t"
|
||||
x ""
|
||||
x "o"
|
||||
x "2k"
|
||||
x "k"
|
||||
x))
|
||||
;;Cut/copy/paste - within same buffer
|
||||
(fset 'ses-exercise-paste-1buf
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "\0w"
|
||||
x ""
|
||||
x "o"
|
||||
x "\"middle\r"
|
||||
x "\0"
|
||||
x "w"
|
||||
x "\0"
|
||||
x "w"
|
||||
x ""
|
||||
x ""
|
||||
x "2y"
|
||||
x "y"
|
||||
x "y"
|
||||
x ">"
|
||||
x "y"
|
||||
x ">y"
|
||||
x "<"
|
||||
x "p\"<%s>\"\r"
|
||||
x "pses-dashfill\r"
|
||||
x "\0"
|
||||
x ""
|
||||
x " "
|
||||
x "y"
|
||||
x "\r\0w"
|
||||
x "\r"
|
||||
x "3(+ G2 H1\r"
|
||||
x "\0w"
|
||||
x ">"
|
||||
x ""
|
||||
x "8(ses-average (ses-range G2 H2)\r"
|
||||
x "\0k"
|
||||
x "7"
|
||||
x ""
|
||||
x "(ses-average (ses-range E7 E9)\r"
|
||||
x "\0 "
|
||||
x ""
|
||||
x "(ses-average (ses-range E7 F7)\r"
|
||||
x "\0k"
|
||||
x ""
|
||||
x "(ses-average (ses-range D6 E6)\r"
|
||||
x "\0k"
|
||||
x ""
|
||||
x "2"
|
||||
x "\"Line A\r"
|
||||
x "pses-tildefill-span\r"
|
||||
x "\"Subline A(1)\r"
|
||||
x "pses-dashfill-span\r"
|
||||
x "\0w"
|
||||
x ""
|
||||
x ""
|
||||
x "\0w"
|
||||
x ""
|
||||
x))
|
||||
;;Cut/copy/paste - between two buffers
|
||||
(fset 'ses-exercise-paste-2buf
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "o\"middle\r\0"
|
||||
x ""
|
||||
x "4bses-test.txt\r"
|
||||
x " "
|
||||
x "\"xxx\0"
|
||||
x "wo"
|
||||
x " "
|
||||
x ""
|
||||
x "o\"\0"
|
||||
x "wo"
|
||||
x "o123.45\0"
|
||||
x "o"
|
||||
x "o1 \0"
|
||||
x "o"
|
||||
x ">y"
|
||||
x "o symb\0"
|
||||
x "oy2y"
|
||||
x "o1\t\0"
|
||||
x "o"
|
||||
x "w9\np\"<%s>\"\n"
|
||||
x "o\n2\t\"3\nxxx\t5\n\0"
|
||||
x "oy"
|
||||
x))
|
||||
;;Export text, import it back
|
||||
(fset 'ses-exercise-import-export
|
||||
(concat y ":(revert-buffer t t)\r"
|
||||
x "\0xt"
|
||||
x "4bses-test.txt\r"
|
||||
x "\n-1o"
|
||||
x "xTo-1o"
|
||||
x "'crunch\r"
|
||||
x "pses-center-span\r"
|
||||
x "\0xT"
|
||||
x "o\n-1o"
|
||||
x "\0y"
|
||||
x "\0xt"
|
||||
x "\0y"
|
||||
x "12345678\r"
|
||||
x "'bunch\r"
|
||||
x "\0xtxT"
|
||||
x)))
|
||||
|
||||
(defun ses-exercise-macros ()
|
||||
"Executes all SES coverage-test macros."
|
||||
(dolist (x '(ses-exercise-example
|
||||
ses-exercise-new
|
||||
ses-exercise-display
|
||||
ses-exercise-formulas
|
||||
ses-exercise-recalc
|
||||
ses-exercise-header-row
|
||||
ses-exercise-unsafe
|
||||
ses-exercise-rows
|
||||
ses-exercise-columns
|
||||
ses-exercise-editing
|
||||
ses-exercise-sort-column
|
||||
ses-exercise-cell-printers
|
||||
ses-exercise-spanning-printers
|
||||
ses-exercise-paste-1buf
|
||||
ses-exercise-paste-2buf
|
||||
ses-exercise-import-export))
|
||||
(message "<Testing %s>" x)
|
||||
(execute-kbd-macro x)))
|
||||
|
||||
(defun ses-exercise-signals ()
|
||||
"Exercise code paths that lead to error signals, other than those for
|
||||
spreadsheet files with invalid formatting."
|
||||
(message "<Checking for expected errors>")
|
||||
(switch-to-buffer "ses-test.ses")
|
||||
(deactivate-mark)
|
||||
(ses-jump 'A1)
|
||||
(ses-set-curcell)
|
||||
(dolist (x '((ses-column-widths 14)
|
||||
(ses-column-printers "%s")
|
||||
(ses-column-printers ["%s" "%s" "%s"]) ;Should be two
|
||||
(ses-column-widths [14])
|
||||
(ses-delete-column -99)
|
||||
(ses-delete-column 2)
|
||||
(ses-delete-row -1)
|
||||
(ses-goto-data 'hogwash)
|
||||
(ses-header-row -56)
|
||||
(ses-header-row 99)
|
||||
(ses-insert-column -14)
|
||||
(ses-insert-row 0)
|
||||
(ses-jump 'B8) ;Covered by preceding cell
|
||||
(ses-printer-validate '("%s" t))
|
||||
(ses-printer-validate '([47]))
|
||||
(ses-read-header-row -1)
|
||||
(ses-read-header-row 32767)
|
||||
(ses-relocate-all 0 0 -1 1)
|
||||
(ses-relocate-all 0 0 1 -1)
|
||||
(ses-select (ses-range A1 A2) 'x (ses-range B1 B1))
|
||||
(ses-set-cell 0 0 'hogwash nil)
|
||||
(ses-set-column-width 0 0)
|
||||
(ses-yank-cells #("a\nb"
|
||||
0 1 (ses (A1 nil nil))
|
||||
2 3 (ses (A3 nil nil)))
|
||||
nil)
|
||||
(ses-yank-cells #("ab"
|
||||
0 1 (ses (A1 nil nil))
|
||||
1 2 (ses (A2 nil nil)))
|
||||
nil)
|
||||
(ses-yank-pop nil)
|
||||
(ses-yank-tsf "1\t2\n3" nil)
|
||||
(let ((curcell nil)) (ses-check-curcell))
|
||||
(let ((curcell 'A1)) (ses-check-curcell 'needrange))
|
||||
(let ((curcell '(A1 . A2))) (ses-check-curcell 'end))
|
||||
(let ((curcell '(A1 . A2))) (ses-sort-column "B"))
|
||||
(let ((curcell '(C1 . D2))) (ses-sort-column "B"))
|
||||
(execute-kbd-macro "jB10\n2")
|
||||
(execute-kbd-macro [?j ?B ?9 ?\n ?C-@ ?C-f ?C-f cut])
|
||||
(progn (kill-new "x") (execute-kbd-macro ">n"))
|
||||
(execute-kbd-macro "\0w")))
|
||||
(condition-case nil
|
||||
(progn
|
||||
(eval x)
|
||||
(signal 'singularity-error nil)) ;Shouldn't get here
|
||||
(singularity-error (error "No error from %s?" x))
|
||||
(error nil)))
|
||||
;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
|
||||
(let ((inhibit-quit t))
|
||||
(setq quit-flag t)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(ses-update-cells '(A1))
|
||||
(signal 'singularity-error nil))
|
||||
(singularity-error (error "Quit failure in ses-update-cells"))
|
||||
(error nil))
|
||||
(setq quit-flag nil)))
|
||||
|
||||
(defun ses-exercise-invalid-spreadsheets ()
|
||||
"Execute code paths that detect invalid spreadsheet files."
|
||||
;;Detect invalid spreadsheets
|
||||
(let ((p&d "\n\n \n(ses-cell A1 nil nil nil nil)\n\n")
|
||||
(cw "(ses-column-widths [7])\n")
|
||||
(cp "(ses-column-printers [ses-center])\n")
|
||||
(dp "(ses-default-printer \"%.7g\")\n")
|
||||
(hr "(ses-header-row 0)\n")
|
||||
(p11 "(2 1 1)")
|
||||
(igp ses-initial-global-parameters))
|
||||
(dolist (x (list "(1)"
|
||||
"(x 2 3)"
|
||||
"(1 x 3)"
|
||||
"(1 -1 0)"
|
||||
"(1 2 x)"
|
||||
"(1 2 -1)"
|
||||
"(3 1 1)"
|
||||
"\n\n (2 1 1)"
|
||||
"\n\n \n(ses-cell)(2 1 1)"
|
||||
"\n\n \n(x)\n(2 1 1)"
|
||||
"\n\n\n \n(ses-cell A2)\n(2 2 2)"
|
||||
"\n\n\n \n(ses-cell B1)\n(2 2 2)"
|
||||
"\n\n \n(ses-cell A1 nil nil nil nil)\n(2 1 1)"
|
||||
(concat p&d "(x)\n(x)\n(x)\n(x)\n" p11)
|
||||
(concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11)
|
||||
(concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)")
|
||||
(concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11)
|
||||
(concat p&d cw cp "(x)\n(x)\n" p11)
|
||||
(concat p&d cw cp "(ses-default-printer)(x)\n" p11)
|
||||
(concat p&d cw cp dp "(x)\n" p11)
|
||||
(concat p&d cw cp dp "(ses-header-row)" p11)
|
||||
(concat p&d cw cp dp hr p11)
|
||||
(concat p&d cw cp dp "\n" hr igp)))
|
||||
(condition-case nil
|
||||
(with-temp-buffer
|
||||
(insert x)
|
||||
(ses-load)
|
||||
(signal 'singularity-error nil)) ;Shouldn't get here
|
||||
(singularity-error (error "%S is an invalid spreadsheet!" x))
|
||||
(error nil)))))
|
||||
|
||||
(defun ses-exercise-startup ()
|
||||
"Prepare for coverage tests"
|
||||
;;Clean up from any previous runs
|
||||
(condition-case nil (kill-buffer "ses-example.ses") (error nil))
|
||||
(condition-case nil (kill-buffer "ses-test.ses") (error nil))
|
||||
(condition-case nil (delete-file "ses-test.ses") (file-error nil))
|
||||
(delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing
|
||||
(setq ses-mode-map nil) ;Force rebuild
|
||||
(testcover-unmark-all "ses.el")
|
||||
;;Enable
|
||||
(let ((testcover-1value-functions
|
||||
;;forward-line always returns 0, for us.
|
||||
;;remove-text-properties always returns t for us.
|
||||
;;ses-recalculate-cell returns the same " " any time curcell is a cons
|
||||
;;Macros ses-dorange and ses-dotimes-msg generate code that always
|
||||
;; returns nil
|
||||
(append '(forward-line remove-text-properties ses-recalculate-cell
|
||||
ses-dorange ses-dotimes-msg)
|
||||
testcover-1value-functions))
|
||||
(testcover-constants
|
||||
;;These maps get initialized, then never changed again
|
||||
(append '(ses-mode-map ses-mode-print-map ses-mode-edit-map)
|
||||
testcover-constants)))
|
||||
(testcover-start "ses.el" t))
|
||||
(require 'unsafep)) ;In case user has safe-functions = t!
|
||||
|
||||
|
||||
;;;#########################################################################
|
||||
(defun ses-exercise ()
|
||||
"Executes all SES coverage tests and displays the results."
|
||||
(interactive)
|
||||
(ses-exercise-startup)
|
||||
;;Run the keyboard-macro tests
|
||||
(let ((safe-functions nil)
|
||||
(ses-initial-size '(1 . 1))
|
||||
(ses-initial-column-width 7)
|
||||
(ses-initial-default-printer "%.7g")
|
||||
(ses-after-entry-functions '(forward-char))
|
||||
(ses-mode-hook nil))
|
||||
(ses-exercise-macros)
|
||||
(ses-exercise-signals)
|
||||
(ses-exercise-invalid-spreadsheets)
|
||||
;;Upgrade of old-style spreadsheet
|
||||
(with-temp-buffer
|
||||
(insert " \n\n \n(ses-cell A1 nil nil nil nil)\n\n(ses-column-widths [7])\n(ses-column-printers [nil])\n(ses-default-printer \"%.7g\")\n\n( ;Global parameters (these are read first)\n 1 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n")
|
||||
(ses-load))
|
||||
;;ses-vector-delete is always called from buffer-undo-list with the same
|
||||
;;symbol as argument. We'll give it a different one here.
|
||||
(let ((x [1 2 3]))
|
||||
(ses-vector-delete 'x 0 0))
|
||||
;;ses-create-header-string behaves differently in a non-window environment
|
||||
;;but we always test under windows.
|
||||
(let ((window-system (not window-system)))
|
||||
(scroll-left 7)
|
||||
(ses-create-header-string))
|
||||
;;Test for nonstandard after-entry functions
|
||||
(let ((ses-after-entry-functions '(forward-line))
|
||||
ses-mode-hook)
|
||||
(ses-read-cell 0 0 1)
|
||||
(ses-read-symbol 0 0 t)))
|
||||
;;Tests with unsafep disabled
|
||||
(let ((safe-functions t)
|
||||
ses-mode-hook)
|
||||
(message "<Checking safe-functions = t>")
|
||||
(kill-buffer "ses-example.ses")
|
||||
(find-file "ses-example.ses"))
|
||||
;;Checks for nonstandard default values for new spreadsheets
|
||||
(let (ses-mode-hook)
|
||||
(dolist (x '(("%.6g" 8 (2 . 2))
|
||||
("%.8g" 6 (3 . 3))))
|
||||
(let ((ses-initial-size (nth 2 x))
|
||||
(ses-initial-column-width (nth 1 x))
|
||||
(ses-initial-default-printer (nth 0 x)))
|
||||
(with-temp-buffer
|
||||
(set-buffer-modified-p t)
|
||||
(ses-mode)))))
|
||||
;;Test error-handling in command hook, outside a macro.
|
||||
;;This will ring the bell.
|
||||
(let (curcell-overlay)
|
||||
(ses-command-hook))
|
||||
;;Due to use of run-with-timer, ses-command-hook sometimes gets called
|
||||
;;after we switch to another buffer.
|
||||
(switch-to-buffer "*scratch*")
|
||||
(ses-command-hook)
|
||||
;;Print results
|
||||
(message "<Marking source code>")
|
||||
(testcover-mark-all "ses.el")
|
||||
(testcover-next-mark)
|
||||
;;Cleanup
|
||||
(delete-other-windows)
|
||||
(kill-buffer "ses-test.txt")
|
||||
;;Could do this here: (testcover-end "ses.el")
|
||||
(message "Done"))
|
||||
|
||||
;; testcover-ses.el ends here.
|
||||
139
lisp/emacs-lisp/testcover-unsafep.el
Normal file
139
lisp/emacs-lisp/testcover-unsafep.el
Normal file
|
|
@ -0,0 +1,139 @@
|
|||
;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
|
||||
|
||||
;; Copyright (C) 2002 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Keywords: safety lisp utility
|
||||
|
||||
;; 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 2, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
(require 'testcover)
|
||||
|
||||
;;;These forms are all considered safe
|
||||
(defconst testcover-unsafep-safe
|
||||
'(((lambda (x) (* x 2)) 14)
|
||||
(apply 'cdr (mapcar '(lambda (x) (car x)) y))
|
||||
(cond ((= x 4) 5) (t 27))
|
||||
(condition-case x (car y) (error (car x)))
|
||||
(dolist (x y) (message "here: %s" x))
|
||||
(dotimes (x 14 (* x 2)) (message "here: %d" x))
|
||||
(let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
|
||||
(let (x) (apply '(lambda (x) (* x 2)) 14))
|
||||
(let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
|
||||
(let ((x 1) (y 2)) (setq x (+ x y)))
|
||||
(let ((x 1)) (let ((y (+ x 3))) (* x y)))
|
||||
(let* nil (current-time))
|
||||
(let* ((x 1) (y (+ x 3))) (* x y))
|
||||
(mapcar (lambda (x &optional y &rest z) (setq y (+ x 2)) (* y 3)) '(1 2 3))
|
||||
(mapconcat #'(lambda (var) (propertize var 'face 'bold)) '("1" "2") ", ")
|
||||
(setq buffer-display-count 14 mark-active t)
|
||||
;;This is not safe if you insert it into a buffer!
|
||||
(propertize "x" 'display '(height (progn (delete-file "x") 1))))
|
||||
"List of forms that `unsafep' should decide are safe.")
|
||||
|
||||
;;;These forms are considered unsafe
|
||||
(defconst testcover-unsafep-unsafe
|
||||
'(( (add-to-list x y)
|
||||
. (unquoted x))
|
||||
( (add-to-list y x)
|
||||
. (unquoted y))
|
||||
( (add-to-list 'y x)
|
||||
. (global-variable y))
|
||||
( (not (delete-file "unsafep.el"))
|
||||
. (function delete-file))
|
||||
( (cond (t (aset local-abbrev-table 0 0)))
|
||||
. (function aset))
|
||||
( (cond (t (setq unsafep-vars "")))
|
||||
. (risky-local-variable unsafep-vars))
|
||||
( (condition-case format-alist 1)
|
||||
. (risky-local-variable format-alist))
|
||||
( (condition-case x 1 (error (setq format-alist "")))
|
||||
. (risky-local-variable format-alist))
|
||||
( (dolist (x (sort globalvar 'car)) (princ x))
|
||||
. (function sort))
|
||||
( (dotimes (x 14) (delete-file "x"))
|
||||
. (function delete-file))
|
||||
( (let ((post-command-hook "/tmp/")) 1)
|
||||
. (risky-local-variable post-command-hook))
|
||||
( (let ((x (delete-file "x"))) 2)
|
||||
. (function delete-file))
|
||||
( (let (x) (add-to-list 'x (delete-file "x")))
|
||||
. (function delete-file))
|
||||
( (let (x) (condition-case y (setq x 1 z 2)))
|
||||
. (global-variable z))
|
||||
( (let (x) (condition-case z 1 (error (delete-file "x"))))
|
||||
. (function delete-file))
|
||||
( (let (x) (mapc (lambda (x) (setcar x 1)) '((1 . 2) (3 . 4))))
|
||||
. (function setcar))
|
||||
( (let (y) (push (delete-file "x") y))
|
||||
. (function delete-file))
|
||||
( (let* ((x 1)) (setq y 14))
|
||||
. (global-variable y))
|
||||
( (mapc 'car (list '(1 . 2) (cons 3 4) (kill-buffer "unsafep.el")))
|
||||
. (function kill-buffer))
|
||||
( (mapcar x y)
|
||||
. (unquoted x))
|
||||
( (mapcar '(lambda (x) (rename-file x "x")) '("unsafep.el"))
|
||||
. (function rename-file))
|
||||
( (mapconcat x1 x2 " ")
|
||||
. (unquoted x1))
|
||||
( (pop format-alist)
|
||||
. (risky-local-variable format-alist))
|
||||
( (push 1 format-alist)
|
||||
. (risky-local-variable format-alist))
|
||||
( (setq buffer-display-count (delete-file "x"))
|
||||
. (function delete-file))
|
||||
;;These are actualy safe (they signal errors)
|
||||
( (apply '(x) '(1 2 3))
|
||||
. (function (x)))
|
||||
( (let (((x))) 1)
|
||||
. (variable (x)))
|
||||
( (let (1) 2)
|
||||
. (variable 1))
|
||||
)
|
||||
"A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
|
||||
|
||||
|
||||
;;;#########################################################################
|
||||
(defun testcover-unsafep ()
|
||||
"Executes all unsafep tests and displays the coverage results."
|
||||
(interactive)
|
||||
(testcover-unmark-all "unsafep.el")
|
||||
(testcover-start "unsafep.el")
|
||||
(let (save-functions)
|
||||
(dolist (x testcover-unsafep-safe)
|
||||
(if (unsafep x)
|
||||
(error "%S should be safe" x)))
|
||||
(dolist (x testcover-unsafep-unsafe)
|
||||
(if (not (equal (unsafep (car x)) (cdr x)))
|
||||
(error "%S should be unsafe: %s" (car x) (cdr x))))
|
||||
(setq safe-functions t)
|
||||
(if (or (unsafep '(delete-file "x"))
|
||||
(unsafep-function 'delete-file))
|
||||
(error "safe-functions=t should allow delete-file"))
|
||||
(setq safe-functions '(setcar))
|
||||
(if (unsafep '(setcar x 1))
|
||||
(error "safe-functions=(setcar) should allow setcar"))
|
||||
(if (not (unsafep '(setcdr x 1)))
|
||||
(error "safe-functions=(setcar) should not allow setcdr")))
|
||||
(testcover-mark-all "unsafep.el")
|
||||
(testcover-end "unsafep.el")
|
||||
(message "Done"))
|
||||
|
||||
;; testcover-unsafep.el ends here.
|
||||
448
lisp/emacs-lisp/testcover.el
Normal file
448
lisp/emacs-lisp/testcover.el
Normal file
|
|
@ -0,0 +1,448 @@
|
|||
;;;; testcover.el -- Visual code-coverage tool
|
||||
|
||||
;; Copyright (C) 2002 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Keywords: lisp utility
|
||||
|
||||
;; 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 2, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; * Use `testcover-start' to instrument a Lisp file for coverage testing.
|
||||
;; * Use `testcover-mark-all' to add overlay "splotches" to the Lisp file's
|
||||
;; buffer to show where coverage is lacking. Normally, a red splotch
|
||||
;; indicates the form was never evaluated; a brown splotch means it always
|
||||
;; evaluted to the same value.
|
||||
;; * Use `testcover-next-mark' (bind it to a key!) to jump to the next spot
|
||||
;; that has a splotch.
|
||||
|
||||
;; * Basic algorithm: use `edebug' to mark up the function text with
|
||||
;; instrumentation callbacks, then replace edebug's callbacks with ours.
|
||||
;; * To show good coverage, we want to see two values for every form, except
|
||||
;; functions that always return the same value and `defconst' variables
|
||||
;; need show only value for good coverage. To avoid the brown splotch, the
|
||||
;; definitions for constants and 1-valued functions must precede the
|
||||
;; references.
|
||||
;; * Use the macro `1value' in your Lisp code to mark spots where the local
|
||||
;; code environment causes a function or variable to always have the same
|
||||
;; value, but the function or variable is not intrinsically 1-valued.
|
||||
;; * Use the macro `noreturn' in your Lisp code to mark function calls that
|
||||
;; never return, because of the local code environment, even though the
|
||||
;; function being called is capable of returning in other cases.
|
||||
|
||||
;; Problems:
|
||||
;; * To detect different values, we store the form's result in a vector and
|
||||
;; compare the next result using `equal'. We don't copy the form's
|
||||
;; result, so if caller alters it (`setcar', etc.) we'll think the next
|
||||
;; call has the same value! Also, equal thinks two strings are the same
|
||||
;; if they differ only in properties.
|
||||
;; * Because we have only a "1value" class and no "always nil" class, we have
|
||||
;; to treat as 1-valued any `and' whose last term is 1-valued, in case the
|
||||
;; last term is always nil. Example:
|
||||
;; (and (< (point) 1000) (forward-char 10))
|
||||
;; This form always returns nil. Similarly, `if' and `cond' are
|
||||
;; treated as 1-valued if all clauses are, in case those values are
|
||||
;; always nil.
|
||||
|
||||
(require 'edebug)
|
||||
(provide 'testcover)
|
||||
|
||||
|
||||
;;;==========================================================================
|
||||
;;; User options
|
||||
;;;==========================================================================
|
||||
|
||||
(defgroup testcover nil
|
||||
"Code-coverage tester"
|
||||
:group 'lisp
|
||||
:prefix "testcover-"
|
||||
:version "21.1")
|
||||
|
||||
(defcustom testcover-constants
|
||||
'(nil t emacs-build-time emacs-version emacs-major-version
|
||||
emacs-minor-version)
|
||||
"Variables whose values never change. No brown splotch is shown for
|
||||
these. This list is quite incomplete!"
|
||||
:group 'testcover
|
||||
:type '(repeat variable))
|
||||
|
||||
(defcustom testcover-1value-functions
|
||||
'(backward-char barf-if-buffer-read-only beginning-of-line
|
||||
buffer-disable-undo buffer-enable-undo current-global-map deactivate-mark
|
||||
delete-char delete-region ding error forward-char insert insert-and-inherit
|
||||
kill-all-local-variables lambda mapc narrow-to-region noreturn push-mark
|
||||
put-text-property run-hooks set-text-properties signal
|
||||
substitute-key-definition suppress-keymap throw undo use-local-map while
|
||||
widen yank)
|
||||
"Functions that always return the same value. No brown splotch is shown
|
||||
for these. This list is quite incomplete! Notes: Nobody ever changes the
|
||||
current global map. The macro `lambda' is self-evaluating, hence always
|
||||
returns the same value (the function it defines may return varying values
|
||||
when called)."
|
||||
:group 'testcover
|
||||
:type 'hook)
|
||||
|
||||
(defcustom testcover-noreturn-functions
|
||||
'(error noreturn throw signal)
|
||||
"Subset of `testcover-1value-functions' -- these never return. We mark
|
||||
them as having returned nil just before calling them."
|
||||
:group 'testcover
|
||||
:type 'hook)
|
||||
|
||||
(defcustom testcover-compose-functions
|
||||
'(+ - * / length list make-keymap make-sparse-keymap message propertize
|
||||
replace-regexp-in-string run-with-idle-timer
|
||||
set-buffer-modified-p)
|
||||
"Functions that are 1-valued if all their args are either constants or
|
||||
calls to one of the `testcover-1value-functions', so if that's true then no
|
||||
brown splotch is shown for these. This list is quite incomplete! Most
|
||||
side-effect-free functions should be here."
|
||||
:group 'testcover
|
||||
:type 'hook)
|
||||
|
||||
(defcustom testcover-progn-functions
|
||||
'(define-key fset function goto-char or overlay-put progn save-current-buffer
|
||||
save-excursion save-match-data save-restriction save-selected-window
|
||||
save-window-excursion set set-default setq setq-default
|
||||
with-output-to-temp-buffer with-syntax-table with-temp-buffer
|
||||
with-temp-file with-temp-message with-timeout)
|
||||
"Functions whose return value is the same as their last argument. No
|
||||
brown splotch is shown for these if the last argument is a constant or a
|
||||
call to one of the `testcover-1value-functions'. This list is probably
|
||||
incomplete! Note: `or' is here in case the last argument is a function that
|
||||
always returns nil."
|
||||
:group 'testcover
|
||||
:type 'hook)
|
||||
|
||||
(defcustom testcover-prog1-functions
|
||||
'(prog1 unwind-protect)
|
||||
"Functions whose return value is the same as their first argument. No
|
||||
brown splotch is shown for these if the first argument is a constant or a
|
||||
call to one of the `testcover-1value-functions'."
|
||||
:group 'testcover
|
||||
:type 'hook)
|
||||
|
||||
(defface testcover-nohits-face
|
||||
'((t (:background "DeepPink2")))
|
||||
"Face for forms that had no hits during coverage test"
|
||||
:group 'testcover)
|
||||
|
||||
(defface testcover-1value-face
|
||||
'((t (:background "Wheat2")))
|
||||
"Face for forms that always produced the same value during coverage test"
|
||||
:group 'testcover)
|
||||
|
||||
|
||||
;;;=========================================================================
|
||||
;;; Other variables
|
||||
;;;=========================================================================
|
||||
|
||||
(defvar testcover-module-constants nil
|
||||
"Symbols declared with defconst in the last file processed by
|
||||
`testcover-start'.")
|
||||
|
||||
(defvar testcover-module-1value-functions nil
|
||||
"Symbols declared with defun in the last file processed by
|
||||
`testcover-start', whose functions always return the same value.")
|
||||
|
||||
(defvar testcover-vector nil
|
||||
"Locally bound to coverage vector for function in progress.")
|
||||
|
||||
|
||||
;;;=========================================================================
|
||||
;;; Add instrumentation to your module
|
||||
;;;=========================================================================
|
||||
|
||||
;;;###autoload
|
||||
(defun testcover-start (filename &optional byte-compile)
|
||||
"Uses edebug to instrument all macros and functions in FILENAME, then
|
||||
changes the instrumentation from edebug to testcover--much faster, no
|
||||
problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is
|
||||
non-nil, byte-compiles each function after instrumenting."
|
||||
(interactive "f")
|
||||
(let ((buf (find-file filename))
|
||||
(load-read-function 'testcover-read)
|
||||
(edebug-all-defs t))
|
||||
(setq edebug-form-data nil
|
||||
testcover-module-constants nil
|
||||
testcover-module-1value-functions nil)
|
||||
(eval-buffer buf))
|
||||
(when byte-compile
|
||||
(dolist (x (reverse edebug-form-data))
|
||||
(when (fboundp (car x))
|
||||
(message "Compiling %s..." (car x))
|
||||
(byte-compile (car x))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun testcover-this-defun ()
|
||||
"Start coverage on function under point."
|
||||
(interactive)
|
||||
(let* ((edebug-all-defs t)
|
||||
(x (symbol-function (eval-defun nil))))
|
||||
(testcover-reinstrument x)
|
||||
x))
|
||||
|
||||
(defun testcover-read (&optional stream)
|
||||
"Read a form using edebug, changing edebug callbacks to testcover callbacks."
|
||||
(let ((x (edebug-read stream)))
|
||||
(testcover-reinstrument x)
|
||||
x))
|
||||
|
||||
(defun testcover-reinstrument (form)
|
||||
"Reinstruments FORM to use testcover instead of edebug. This function
|
||||
modifies the list that FORM points to. Result is non-nil if FORM will
|
||||
always return the same value."
|
||||
(let ((fun (car-safe form)))
|
||||
(cond
|
||||
((not fun) ;Atom
|
||||
(or (not (symbolp form))
|
||||
(memq form testcover-constants)
|
||||
(memq form testcover-module-constants)))
|
||||
((consp fun) ;Embedded list
|
||||
(testcover-reinstrument fun)
|
||||
(testcover-reinstrument-list (cdr form))
|
||||
nil)
|
||||
((or (memq fun testcover-1value-functions)
|
||||
(memq fun testcover-module-1value-functions))
|
||||
;;Always return same value
|
||||
(testcover-reinstrument-list (cdr form))
|
||||
t)
|
||||
((memq fun testcover-progn-functions)
|
||||
;;1-valued if last argument is
|
||||
(testcover-reinstrument-list (cdr form)))
|
||||
((memq fun testcover-prog1-functions)
|
||||
;;1-valued if first argument is
|
||||
(testcover-reinstrument-list (cddr form))
|
||||
(testcover-reinstrument (cadr form)))
|
||||
((memq fun testcover-compose-functions)
|
||||
;;1-valued if all arguments are
|
||||
(setq fun t)
|
||||
(mapc #'(lambda (x) (setq fun (or (testcover-reinstrument x) fun)))
|
||||
(cdr form))
|
||||
fun)
|
||||
((eq fun 'edebug-enter)
|
||||
;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
|
||||
;; => (testcover-enter 'SYM #'(lambda nil FORMS))
|
||||
(setcar form 'testcover-enter)
|
||||
(setcdr (nthcdr 1 form) (nthcdr 3 form))
|
||||
(let ((testcover-vector (get (cadr (cadr form)) 'edebug-coverage)))
|
||||
(testcover-reinstrument-list (nthcdr 2 (cadr (nth 2 form))))))
|
||||
((eq fun 'edebug-after)
|
||||
;;(edebug-after (edebug-before XXX) YYY FORM)
|
||||
;; => (testcover-after YYY FORM), mark XXX as ok-coverage
|
||||
(unless (eq (cadr form) 0)
|
||||
(aset testcover-vector (cadr (cadr form)) 'ok-coverage))
|
||||
(setq fun (nth 2 form))
|
||||
(setcdr form (nthcdr 2 form))
|
||||
(if (not (memq (car-safe (nth 2 form)) testcover-noreturn-functions))
|
||||
(setcar form 'testcover-after)
|
||||
;;This function won't return, so set the value in advance
|
||||
;;(edebug-after (edebug-before XXX) YYY FORM)
|
||||
;; => (progn (edebug-after YYY nil) FORM)
|
||||
(setcar form 'progn)
|
||||
(setcar (cdr form) `(testcover-after ,fun nil)))
|
||||
(when (testcover-reinstrument (nth 2 form))
|
||||
(aset testcover-vector fun '1value)))
|
||||
((eq fun 'defun)
|
||||
(if (testcover-reinstrument-list (nthcdr 3 form))
|
||||
(push (cadr form) testcover-module-1value-functions)))
|
||||
((eq fun 'defconst)
|
||||
;;Define this symbol as 1-valued
|
||||
(push (cadr form) testcover-module-constants)
|
||||
(testcover-reinstrument-list (cddr form)))
|
||||
((memq fun '(dotimes dolist))
|
||||
;;Always returns third value from SPEC
|
||||
(testcover-reinstrument-list (cddr form))
|
||||
(setq fun (testcover-reinstrument-list (cadr form)))
|
||||
(if (nth 2 (cadr form))
|
||||
fun
|
||||
;;No third value, always returns nil
|
||||
t))
|
||||
((memq fun '(let let*))
|
||||
;;Special parsing for second argument
|
||||
(mapc 'testcover-reinstrument-list (cadr form))
|
||||
(testcover-reinstrument-list (cddr form)))
|
||||
((eq fun 'if)
|
||||
;;1-valued if both THEN and ELSE clauses are
|
||||
(testcover-reinstrument (cadr form))
|
||||
(let ((then (testcover-reinstrument (nth 2 form)))
|
||||
(else (testcover-reinstrument-list (nthcdr 3 form))))
|
||||
(and then else)))
|
||||
((memq fun '(when unless and))
|
||||
;;1-valued if last clause of BODY is
|
||||
(testcover-reinstrument-list (cdr form)))
|
||||
((eq fun 'cond)
|
||||
;;1-valued if all clauses are
|
||||
(testcover-reinstrument-clauses (cdr form)))
|
||||
((eq fun 'condition-case)
|
||||
;;1-valued if BODYFORM is and all HANDLERS are
|
||||
(let ((body (testcover-reinstrument (nth 2 form)))
|
||||
(errs (testcover-reinstrument-clauses (mapcar #'cdr
|
||||
(nthcdr 3 form)))))
|
||||
(and body errs)))
|
||||
((eq fun 'quote)
|
||||
;;Don't reinstrument what's inside!
|
||||
;;This doesn't apply within a backquote
|
||||
t)
|
||||
((eq fun '\`)
|
||||
;;Quotes are not special within backquotes
|
||||
(let ((testcover-1value-functions
|
||||
(cons 'quote testcover-1value-functions)))
|
||||
(testcover-reinstrument (cadr form))))
|
||||
((eq fun '\,)
|
||||
;;In commas inside backquotes, quotes are special again
|
||||
(let ((testcover-1value-functions
|
||||
(remq 'quote testcover-1value-functions)))
|
||||
(testcover-reinstrument (cadr form))))
|
||||
((memq fun '(1value noreturn))
|
||||
;;Hack - pretend the arg is 1-valued here
|
||||
(if (symbolp (cadr form)) ;A pseudoconstant variable
|
||||
t
|
||||
(let ((testcover-1value-functions
|
||||
(cons (car (cadr form)) testcover-1value-functions)))
|
||||
(testcover-reinstrument (cadr form)))))
|
||||
(t ;Some other function or weird thing
|
||||
(testcover-reinstrument-list (cdr form))
|
||||
nil))))
|
||||
|
||||
(defun testcover-reinstrument-list (list)
|
||||
"Reinstruments each form in LIST to use testcover instead of edebug.
|
||||
This function modifies the forms in LIST. Result is `testcover-reinstrument's
|
||||
value for the last form in LIST. If the LIST is empty, its evaluation will
|
||||
always be nil, so we return t for 1-valued."
|
||||
(let ((result t))
|
||||
(while (consp list)
|
||||
(setq result (testcover-reinstrument (pop list))))
|
||||
result))
|
||||
|
||||
(defun testcover-reinstrument-clauses (clauselist)
|
||||
"Reinstruments each list in CLAUSELIST. Result is t if every
|
||||
clause is 1-valued."
|
||||
(let ((result t))
|
||||
(mapc #'(lambda (x)
|
||||
(setq result (and (testcover-reinstrument-list x) result)))
|
||||
clauselist)
|
||||
result))
|
||||
|
||||
(defun testcover-end (buffer)
|
||||
"Turn off instrumentation of all macros and functions in FILENAME."
|
||||
(interactive "b")
|
||||
(let ((buf (find-file-noselect buffer)))
|
||||
(eval-buffer buf t)))
|
||||
|
||||
(defmacro 1value (form)
|
||||
"For code-coverage testing, indicate that FORM is expected to always have
|
||||
the same value."
|
||||
form)
|
||||
|
||||
(defmacro noreturn (form)
|
||||
"For code-coverage testing, indicate that FORM will always signal an error."
|
||||
form)
|
||||
|
||||
|
||||
;;;=========================================================================
|
||||
;;; Accumulate coverage data
|
||||
;;;=========================================================================
|
||||
|
||||
(defun testcover-enter (testcover-sym testcover-fun)
|
||||
"Internal function for coverage testing. Invokes TESTCOVER-FUN while
|
||||
binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM
|
||||
\(the name of the current function)."
|
||||
(let ((testcover-vector (get testcover-sym 'edebug-coverage)))
|
||||
(funcall testcover-fun)))
|
||||
|
||||
(defun testcover-after (idx val)
|
||||
"Internal function for coverage testing. Returns VAL after installing it in
|
||||
`testcover-vector' at offset IDX."
|
||||
(cond
|
||||
((eq (aref testcover-vector idx) 'unknown)
|
||||
(aset testcover-vector idx val))
|
||||
((not (equal (aref testcover-vector idx) val))
|
||||
(aset testcover-vector idx 'ok-coverage)))
|
||||
val)
|
||||
|
||||
|
||||
;;;=========================================================================
|
||||
;;; Display the coverage data as color splotches on your code.
|
||||
;;;=========================================================================
|
||||
|
||||
(defun testcover-mark (def)
|
||||
"Marks one DEF (a function or macro symbol) to highlight its contained forms
|
||||
that did not get completely tested during coverage tests.
|
||||
A marking of testcover-nohits-face (default = red) indicates that the
|
||||
form was never evaluated. A marking of testcover-1value-face
|
||||
\(default = tan) indicates that the form always evaluated to the same value.
|
||||
The forms throw, error, and signal are not marked. They do not return and
|
||||
would always get a red mark. Some forms that always return the same
|
||||
value (e.g., setq of a constant), always get a tan mark that can't be
|
||||
eliminated by adding more test cases."
|
||||
(let* ((data (get def 'edebug))
|
||||
(def-mark (car data))
|
||||
(points (nth 2 data))
|
||||
(len (length points))
|
||||
(changed (buffer-modified-p))
|
||||
(coverage (get def 'edebug-coverage))
|
||||
ov j item)
|
||||
(or (and def-mark points coverage)
|
||||
(error "Missing edebug data for function %s" def))
|
||||
(set-buffer (marker-buffer def-mark))
|
||||
(mapc 'delete-overlay (overlays-in def-mark
|
||||
(+ def-mark (aref points (1- len)) 1)))
|
||||
(while (> len 0)
|
||||
(setq len (1- len)
|
||||
data (aref coverage len))
|
||||
(when (and (not (eq data 'ok-coverage))
|
||||
(setq j (+ def-mark (aref points len))))
|
||||
(setq ov (make-overlay (1- j) j))
|
||||
(overlay-put ov 'face
|
||||
(if (memq data '(unknown 1value))
|
||||
'testcover-nohits-face
|
||||
'testcover-1value-face))))
|
||||
(set-buffer-modified-p changed)))
|
||||
|
||||
(defun testcover-mark-all (&optional buffer)
|
||||
"Mark all forms in BUFFER that did not get completley tested during
|
||||
coverage tests. This function creates many overlays. SKIPFUNCS is a list
|
||||
of function-symbols that should not be marked."
|
||||
(interactive "b")
|
||||
(if buffer
|
||||
(switch-to-buffer buffer))
|
||||
(goto-char 1)
|
||||
(dolist (x edebug-form-data)
|
||||
(if (fboundp (car x))
|
||||
(testcover-mark (car x)))))
|
||||
|
||||
(defun testcover-unmark-all (buffer)
|
||||
"Remove all overlays from FILENAME."
|
||||
(interactive "b")
|
||||
(condition-case nil
|
||||
(progn
|
||||
(set-buffer buffer)
|
||||
(mapc 'delete-overlay (overlays-in 1 (buffer-size))))
|
||||
(error nil))) ;Ignore "No such buffer" errors
|
||||
|
||||
(defun testcover-next-mark ()
|
||||
"Moves point to next line in current buffer that has a splotch."
|
||||
(interactive)
|
||||
(goto-char (next-overlay-change (point)))
|
||||
(end-of-line))
|
||||
|
||||
;; testcover.el ends here.
|
||||
260
lisp/emacs-lisp/unsafep.el
Normal file
260
lisp/emacs-lisp/unsafep.el
Normal file
|
|
@ -0,0 +1,260 @@
|
|||
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
|
||||
|
||||
;; Copyright (C) Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
|
||||
;; Keywords: safety lisp utility
|
||||
|
||||
;; 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 2, 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; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is a simplistic implementation that does not allow any modification of
|
||||
;; buffers or global variables. It does no dataflow analysis, so functions
|
||||
;; like `funcall' and `setcar' are completely disallowed. It is designed
|
||||
;; for "pure Lisp" formulas, like those in spreadsheets, that don't make any
|
||||
;; use of the text editing capabilities of Emacs.
|
||||
|
||||
;; A formula is safe if:
|
||||
;; 1. It's an atom.
|
||||
;; 2. It's a function call to a safe function and all arguments are safe
|
||||
;; formulas.
|
||||
;; 3. It's a special form whose arguments are like a function's (and,
|
||||
;; catch, if, or, prog1, prog2, progn, while, unwind-protect).
|
||||
;; 4. It's a special form or macro that creates safe temporary bindings
|
||||
;; (condition-case, dolist, dotimes, lambda, let, let*).
|
||||
;; 4. It's one of (cond, quote) that have special parsing.
|
||||
;; 5. It's one of (add-to-list, setq, push, pop) and the assignment variable
|
||||
;; is safe.
|
||||
;; 6. It's one of (apply, mapc, mapcar, mapconcat) and its first arg is a
|
||||
;; quoted safe function.
|
||||
;;
|
||||
;; A function is safe if:
|
||||
;; 1. It's a lambda containing safe formulas.
|
||||
;; 2. It's a member of list `safe-functions', so the user says it's safe.
|
||||
;; 3. It's a symbol with the `side-effect-free' property, defined by the
|
||||
;; byte compiler or function author.
|
||||
;; 4. It's a symbol with the `safe-function' property, defined here or by
|
||||
;; the function author. Value t indicates a function that is safe but
|
||||
;; has innocuous side effects. Other values will someday indicate
|
||||
;; functions with side effects that are not always safe.
|
||||
;; The `side-effect-free' and `safe-function' properties are provided for
|
||||
;; built-in functions and for functions and macros defined in subr.el.
|
||||
;;
|
||||
;; A temporary binding is unsafe if its symbol:
|
||||
;; 1. Has the `risky-local-variable' property.
|
||||
;; 2. Has a name that ends with -command, font-lock-keywords(-[0-9]+)?,
|
||||
;; font-lock-syntactic-keywords, -form, -forms, -frame-alist, -function,
|
||||
;; -functions, -history, -hook, -hooks, -map, -map-alist, -mode-alist,
|
||||
;; -predicate, or -program.
|
||||
;;
|
||||
;; An assignment variable is unsafe if:
|
||||
;; 1. It would be unsafe as a temporary binding.
|
||||
;; 2. It doesn't already have a temporary or buffer-local binding.
|
||||
|
||||
;; There are unsafe forms that `unsafep' cannot detect. Beware of these:
|
||||
;; 1. The form's result is a string with a display property containing a
|
||||
;; form to be evaluated later, and you insert this result into a
|
||||
;; buffer. Always remove display properties before inserting!
|
||||
;; 2. The form alters a risky variable that was recently added to Emacs and
|
||||
;; is not yet marked with the `risky-local-variable' property.
|
||||
;; 3. The form uses undocumented features of built-in functions that have
|
||||
;; the `side-effect-free' property. For example, in Emacs-20 if you
|
||||
;; passed a circular list to `assoc', Emacs would crash. Historically,
|
||||
;; problems of this kind have been few and short-lived.
|
||||
|
||||
(provide 'unsafep)
|
||||
(require 'byte-opt) ;Set up the `side-effect-free' properties
|
||||
|
||||
(defcustom safe-functions nil
|
||||
"t to disable all safety checks, or a list of assumed-safe functions."
|
||||
:group 'lisp
|
||||
:type '(choice (const :tag "No" nil) (const :tag "Yes" t) hook))
|
||||
|
||||
(defvar unsafep-vars nil
|
||||
"Dynamically-bound list of variables that have lexical bindings at this
|
||||
point in the parse.")
|
||||
(put 'unsafep-vars 'risky-local-variable t)
|
||||
|
||||
;;Side-effect-free functions from subr.el
|
||||
(dolist (x '(assoc-default assoc-ignore-case butlast last match-string
|
||||
match-string-no-properties member-ignore-case remove remq))
|
||||
(put x 'side-effect-free t))
|
||||
|
||||
;;Other safe functions
|
||||
(dolist (x '(;;Special forms
|
||||
and catch if or prog1 prog2 progn while unwind-protect
|
||||
;;Safe subrs that have some side-effects
|
||||
ding error message minibuffer-message random read-minibuffer
|
||||
signal sleep-for string-match throw y-or-n-p yes-or-no-p
|
||||
;;Defsubst functions from subr.el
|
||||
caar cadr cdar cddr
|
||||
;;Macros from subr.el
|
||||
save-match-data unless when with-temp-message
|
||||
;;Functions from subr.el that have side effects
|
||||
read-passwd split-string replace-regexp-in-string
|
||||
play-sound-file))
|
||||
(put x 'safe-function t))
|
||||
|
||||
;;;###autoload
|
||||
(defun unsafep (form &optional unsafep-vars)
|
||||
"Return nil if evaluating FORM couldn't possibly do any harm; otherwise
|
||||
result is a reason why FORM is unsafe. UNSAFEP-VARS is a list of symbols
|
||||
with local bindings."
|
||||
(catch 'unsafep
|
||||
(if (or (eq safe-functions t) ;User turned off safety-checking
|
||||
(atom form)) ;Atoms are never unsafe
|
||||
(throw 'unsafep nil))
|
||||
(let* ((fun (car form))
|
||||
(reason (unsafep-function fun))
|
||||
arg)
|
||||
(cond
|
||||
((not reason)
|
||||
;;It's a normal function - unsafe if any arg is
|
||||
(unsafep-progn (cdr form)))
|
||||
((eq fun 'quote)
|
||||
;;Never unsafe
|
||||
nil)
|
||||
((memq fun '(apply mapc mapcar mapconcat))
|
||||
;;Unsafe if 1st arg isn't a quoted lambda
|
||||
(setq arg (cadr form))
|
||||
(cond
|
||||
((memq (car-safe arg) '(quote function))
|
||||
(setq reason (unsafep-function (cadr arg))))
|
||||
((eq (car-safe arg) 'lambda)
|
||||
;;Self-quoting lambda
|
||||
(setq reason (unsafep arg unsafep-vars)))
|
||||
(t
|
||||
(setq reason `(unquoted ,arg))))
|
||||
(or reason (unsafep-progn (cddr form))))
|
||||
((eq fun 'lambda)
|
||||
;;First arg is temporary bindings
|
||||
(mapc #'(lambda (x)
|
||||
(let ((y (unsafep-variable x t)))
|
||||
(if y (throw 'unsafep y)))
|
||||
(or (memq x '(&optional &rest))
|
||||
(push x unsafep-vars)))
|
||||
(cadr form))
|
||||
(unsafep-progn (cddr form)))
|
||||
((eq fun 'let)
|
||||
;;Creates temporary bindings in one step
|
||||
(setq unsafep-vars (nconc (mapcar #'unsafep-let (cadr form))
|
||||
unsafep-vars))
|
||||
(unsafep-progn (cddr form)))
|
||||
((eq fun 'let*)
|
||||
;;Creates temporary bindings iteratively
|
||||
(dolist (x (cadr form))
|
||||
(push (unsafep-let x) unsafep-vars))
|
||||
(unsafep-progn (cddr form)))
|
||||
((eq fun 'setq)
|
||||
;;Safe if odd arguments are local-var syms, evens are safe exprs
|
||||
(setq arg (cdr form))
|
||||
(while arg
|
||||
(setq reason (or (unsafep-variable (car arg) nil)
|
||||
(unsafep (cadr arg) unsafep-vars)))
|
||||
(if reason (throw 'unsafep reason))
|
||||
(setq arg (cddr arg))))
|
||||
((eq fun 'pop)
|
||||
;;safe if arg is local-var sym
|
||||
(unsafep-variable (cadr form) nil))
|
||||
((eq fun 'push)
|
||||
;;Safe if 2nd arg is a local-var sym
|
||||
(or (unsafep (cadr form) unsafep-vars)
|
||||
(unsafep-variable (nth 2 form) nil)))
|
||||
((eq fun 'add-to-list)
|
||||
;;Safe if first arg is a quoted local-var sym
|
||||
(setq arg (cadr form))
|
||||
(if (not (eq (car-safe arg) 'quote))
|
||||
`(unquoted ,arg)
|
||||
(or (unsafep-variable (cadr arg) nil)
|
||||
(unsafep-progn (cddr form)))))
|
||||
((eq fun 'cond)
|
||||
;;Special form with unusual syntax - safe if all args are
|
||||
(dolist (x (cdr form))
|
||||
(setq reason (unsafep-progn x))
|
||||
(if reason (throw 'unsafep reason))))
|
||||
((memq fun '(dolist dotimes))
|
||||
;;Safe if COUNT and RESULT are safe. VAR is bound while checking BODY.
|
||||
(setq arg (cadr form))
|
||||
(or (unsafep-progn (cdr arg))
|
||||
(let ((unsafep-vars (cons (car arg) unsafep-vars)))
|
||||
(unsafep-progn (cddr form)))))
|
||||
((eq fun 'condition-case)
|
||||
;;Special form with unusual syntax - safe if all args are
|
||||
(or (unsafep-variable (cadr form) t)
|
||||
(unsafep (nth 2 form) unsafep-vars)
|
||||
(let ((unsafep-vars (cons (cadr form) unsafep-vars)))
|
||||
;;var is bound only during handlers
|
||||
(dolist (x (nthcdr 3 form))
|
||||
(setq reason (unsafep-progn (cdr x)))
|
||||
(if reason (throw 'unsafep reason))))))
|
||||
(t
|
||||
;;First unsafep-function call above wasn't nil, no special case applies
|
||||
reason)))))
|
||||
|
||||
|
||||
(defun unsafep-function (fun)
|
||||
"Return nil if FUN is a safe function (either a safe lambda or a
|
||||
symbol that names a safe function). Otherwise result is a reason code."
|
||||
(cond
|
||||
((eq (car-safe fun) 'lambda)
|
||||
(unsafep fun unsafep-vars))
|
||||
((not (and (symbolp fun)
|
||||
(or (get fun 'side-effect-free)
|
||||
(eq (get fun 'safe-function) t)
|
||||
(eq safe-functions t)
|
||||
(memq fun safe-functions))))
|
||||
`(function ,fun))))
|
||||
|
||||
(defun unsafep-progn (list)
|
||||
"Return nil if all forms in LIST are safe, or the reason for the first
|
||||
unsafe form."
|
||||
(catch 'unsafep-progn
|
||||
(let (reason)
|
||||
(dolist (x list)
|
||||
(setq reason (unsafep x unsafep-vars))
|
||||
(if reason (throw 'unsafep-progn reason))))))
|
||||
|
||||
(defun unsafep-let (clause)
|
||||
"CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL). Throws a
|
||||
reason to `unsafep' if VAL isn't safe. Returns SYM."
|
||||
(let (reason sym)
|
||||
(if (atom clause)
|
||||
(setq sym clause)
|
||||
(setq sym (car clause)
|
||||
reason (unsafep (cadr clause) unsafep-vars)))
|
||||
(setq reason (or (unsafep-variable sym t) reason))
|
||||
(if reason (throw 'unsafep reason))
|
||||
sym))
|
||||
|
||||
(defun unsafep-variable (sym global-okay)
|
||||
"Returns nil if SYM is lexically bound or is a non-risky buffer-local
|
||||
variable, otherwise a reason why it is unsafe. Failing to be locally bound
|
||||
is okay if GLOBAL-OKAY is non-nil."
|
||||
(cond
|
||||
((not (symbolp sym))
|
||||
`(variable ,sym))
|
||||
((risky-local-variable-p sym)
|
||||
`(risky-local-variable ,sym))
|
||||
((not (or global-okay
|
||||
(memq sym unsafep-vars)
|
||||
(local-variable-p sym)))
|
||||
`(global-variable ,sym))))
|
||||
|
||||
;; unsafep.el ends here.
|
||||
|
|
@ -1617,6 +1617,7 @@ in that case, this function acts as if `enable-local-variables' were t."
|
|||
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
|
||||
("\\.[1-9]\\'" . nroff-mode)
|
||||
("\\.g\\'" . antlr-mode)
|
||||
("\\.ses\\'" . ses-mode)
|
||||
("\\.in\\'" nil t)))
|
||||
"Alist of filename patterns vs corresponding major mode functions.
|
||||
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
|
||||
|
|
@ -2010,6 +2011,7 @@ is specified, returning t if it is specified."
|
|||
(put 'ignored-local-variables 'risky-local-variable t)
|
||||
(put 'eval 'risky-local-variable t)
|
||||
(put 'file-name-handler-alist 'risky-local-variable t)
|
||||
(put 'inhibit-quit 'risky-local-variable t)
|
||||
(put 'minor-mode-alist 'risky-local-variable t)
|
||||
(put 'minor-mode-map-alist 'risky-local-variable t)
|
||||
(put 'minor-mode-overriding-map-alist 'risky-local-variable t)
|
||||
|
|
@ -2058,6 +2060,14 @@ is specified, returning t if it is specified."
|
|||
;; This one is safe because the user gets to check it before it is used.
|
||||
(put 'compile-command 'safe-local-variable t)
|
||||
|
||||
(defun risky-local-variable-p (sym)
|
||||
"Returns non-nil if SYM could be dangerous as a file-local variable."
|
||||
(or (memq sym ignored-local-variables)
|
||||
(get sym 'risky-local-variable)
|
||||
(and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
|
||||
(symbol-name sym))
|
||||
(not (get sym 'safe-local-variable)))))
|
||||
|
||||
(defcustom safe-local-eval-forms nil
|
||||
"*Expressions that are considered \"safe\" in an `eval:' local variable.
|
||||
Add expressions to this list if you want Emacs to evaluate them, when
|
||||
|
|
@ -2122,15 +2132,9 @@ is considered risky."
|
|||
((eq var 'coding)
|
||||
;; We have already handled coding: tag in set-auto-coding.
|
||||
nil)
|
||||
((memq var ignored-local-variables)
|
||||
nil)
|
||||
;; "Setting" eval means either eval it or do nothing.
|
||||
;; Likewise for setting hook variables.
|
||||
((or (get var 'risky-local-variable)
|
||||
(and
|
||||
(string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
|
||||
(symbol-name var))
|
||||
(not (get var 'safe-local-variable))))
|
||||
((risky-local-variable-p var)
|
||||
;; Permit evalling a put of a harmless property.
|
||||
;; if the args do nothing tricky.
|
||||
(if (or (and (eq var 'eval)
|
||||
|
|
|
|||
2914
lisp/ses.el
Normal file
2914
lisp/ses.el
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -1,3 +1,12 @@
|
|||
2002-09-16 Jonathan Yavner <jyavner@engineer.com>
|
||||
|
||||
* variables.texi (File Local Variables): New function
|
||||
risky-local-variable-p.
|
||||
|
||||
2002-09-15 Jonathan Yavner <jyavner@engineer.com>
|
||||
|
||||
* functions.texi (Function safety): New node about unsafep.
|
||||
|
||||
2002-08-05 Per Abrahamsen <abraham@dina.kvl.dk>
|
||||
|
||||
* customize.texi (Splicing into Lists): Fixed example.
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@ define them.
|
|||
* Function Cells:: Accessing or setting the function definition
|
||||
of a symbol.
|
||||
* Inline Functions:: Defining functions that the compiler will open code.
|
||||
* Function safety:: Determining whether a function is safe to call.
|
||||
* Related Topics:: Cross-references to specific Lisp primitives
|
||||
that have a special bearing on how functions work.
|
||||
@end menu
|
||||
|
|
@ -1157,6 +1158,95 @@ do for macros. (@xref{Argument Evaluation}.)
|
|||
Inline functions can be used and open-coded later on in the same file,
|
||||
following the definition, just like macros.
|
||||
|
||||
@node Function safety
|
||||
@section Determining whether a function is safe to call
|
||||
@cindex function safety
|
||||
@cindex safety of functions
|
||||
@cindex virus detection
|
||||
@cindex Trojan-horse detection
|
||||
@cindex DDoS attacks
|
||||
|
||||
Some major modes such as SES (see @pxref{Top,,,ses}) will call
|
||||
functions that are stored in user files. User files sometimes have
|
||||
poor pedigrees---you can get a spreadsheet from someone you've just
|
||||
met, or you can get one through email from someone you've never met.
|
||||
Such files can contain viruses and other Trojan horses that could
|
||||
corrupt your operating system environment, delete your files, or even
|
||||
turn your computer into a DDoS zombie! To avoid this terrible fate,
|
||||
you should not call a function whose source code is stored in a user
|
||||
file until you have determined that it is safe.
|
||||
|
||||
@defun unsafep form &optional unsafep-vars
|
||||
Returns nil if @var{form} is a @dfn{safe} lisp expression, or returns
|
||||
a list that describes why it might be unsafe. The argument
|
||||
@var{unsafep-vars} is a list of symbols known to have temporary
|
||||
bindings at this point; it is mainly used for internal recursive
|
||||
calls. The current buffer is an implicit argument, which provides a
|
||||
list of buffer-local bindings.
|
||||
@end defun
|
||||
|
||||
Being quick and simple, @code{unsafep} does a very light analysis and
|
||||
rejects many Lisp expressions that are actually safe. There are no
|
||||
known cases where @code{unsafep} returns nil for an unsafe expression.
|
||||
However, a ``safe'' Lisp expression can return a string with a
|
||||
@code{display} property, containing an associated Lisp expression to
|
||||
be executed after the string is inserted into a buffer. This
|
||||
associated expression can be a virus. In order to be safe, you must
|
||||
delete properties from all strings calculated by user code before
|
||||
inserting them into buffers.
|
||||
|
||||
What is a safe Lisp expression? Basically, it's an expression that
|
||||
calls only built-in functions with no side effects (or only innocuous
|
||||
ones). Innocuous side effects include displaying messages and
|
||||
altering non-risky buffer-local variables (but not global variables).
|
||||
|
||||
@table @dfn
|
||||
@item Safe expression
|
||||
@itemize
|
||||
@item
|
||||
An atom or quoted thing.
|
||||
@item
|
||||
A call to a safe function (see below), if all its arguments are
|
||||
safe expressions.
|
||||
@item
|
||||
One of the special forms [and, catch, cond, if, or, prog1, prog2,
|
||||
progn, while, unwind-protect], if all its arguments are safe.
|
||||
@item
|
||||
A form that creates temporary bindings [condition-case, dolist,
|
||||
dotimes, lambda, let, let*], if all args are safe and the symbols to
|
||||
be bound are not explicitly risky (see @pxref{File Local Variables}).
|
||||
@item
|
||||
An assignment [add-to-list, setq, push, pop], if all args are safe and
|
||||
the symbols to be assigned are not explicitly risky and they already
|
||||
have temporary or buffer-local bindings.
|
||||
@item
|
||||
One of [apply, mapc, mapcar, mapconcat] if the first argument is a
|
||||
safe explicit lambda and the other args are safe expressions.
|
||||
@end itemize
|
||||
|
||||
@item Safe function
|
||||
@itemize
|
||||
@item
|
||||
A lambda containing safe expressions.
|
||||
@item
|
||||
A symbol on the list @code{safe-functions}, so the user says it's safe.
|
||||
@item
|
||||
A symbol with a non-nil @code{side-effect-free} property.
|
||||
@item
|
||||
A symbol with a non-nil @code{safe-function} property. Value t
|
||||
indicates a function that is safe but has innocuous side effects.
|
||||
Other values will someday indicate functions with classes of side
|
||||
effects that are not always safe.
|
||||
@end itemize
|
||||
|
||||
The @code{side-effect-free} and @code{safe-function} properties are
|
||||
provided for built-in functions and for low-level functions and macros
|
||||
defined in @file{subr.el}. You can assign these properties for the
|
||||
functions you write.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@c Emacs versions prior to 19 did not have inline functions.
|
||||
|
||||
@node Related Topics
|
||||
|
|
|
|||
|
|
@ -1738,15 +1738,20 @@ be called later, or an expression that will be executed later, simply
|
|||
visiting a file could take over your Emacs. To prevent this, Emacs
|
||||
takes care not to allow local variable lists to set such variables.
|
||||
|
||||
For one thing, any variable whose name ends in @samp{-function},
|
||||
@samp{-functions}, @samp{-hook}, @samp{-hooks}, @samp{-form},
|
||||
@samp{-forms}, @samp{-program}, @samp{-command} or @samp{-predicate}
|
||||
cannot be set in a local variable list. In general, you should use such
|
||||
a name whenever it is appropriate for the variable's meaning.
|
||||
For one thing, any variable whose name ends in @samp{-command},
|
||||
@same{-frame-alist}, @samp{-function}, @samp{-functions},
|
||||
@samp{-hook}, @samp{-hooks}, @samp{-form}, @samp{-forms}, @samp{-map},
|
||||
@samp{-map-alist}, @samp{-mode-alist}, @samp{-program}, or
|
||||
@samp{-predicate} cannot be set in a local variable list. In general,
|
||||
you should use such a name whenever it is appropriate for the
|
||||
variable's meaning. The variables @samp{font-lock-keywords},
|
||||
@samp{font-lock-keywords-[0-9]}, and
|
||||
@samp{font-lock-syntactic-keywords} cannot be set in a local variable
|
||||
list, either.
|
||||
|
||||
In addition, any variable whose name has a non-@code{nil}
|
||||
@code{risky-local-variable} property is also ignored. So are
|
||||
all variables listed in @code{ignored-local-variables}:
|
||||
@code{risky-local-variable} property is also ignored. So are all
|
||||
variables listed in @code{ignored-local-variables}:
|
||||
|
||||
@defvar ignored-local-variables
|
||||
This variable holds a list of variables that should not be
|
||||
|
|
@ -1754,6 +1759,10 @@ set by a file's local variables list. Any value specified
|
|||
for one of these variables is ignored.
|
||||
@end defvar
|
||||
|
||||
@defun risky-local-variable-p sym
|
||||
Returns non-nil if @var{sym} is risky for any of the reasons stated above.
|
||||
@end defun
|
||||
|
||||
The @samp{Eval:} ``variable'' is also a potential loophole, so Emacs
|
||||
normally asks for confirmation before handling it.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2002-09-10 Jonathan Yavner <jyavner@engineer.com>
|
||||
|
||||
* Makefile.in (INFO_TARGETS, DVI_TARGETS): Add SES.
|
||||
(../info/ses, ses.dvi): New targets.
|
||||
* ses.texi: New file.
|
||||
|
||||
2002-09-06 Pavel Jan,Bm(Bk <Pavel@Janik.cz>
|
||||
|
||||
* texinfo.tex: Updated to texinfo 4.2.
|
||||
|
|
|
|||
|
|
@ -39,13 +39,13 @@ INFO_TARGETS = ../info/emacs ../info/ccmode ../info/cl \
|
|||
../info/efaq ../info/ada-mode ../info/autotype ../info/calc \
|
||||
../info/idlwave ../info/eudc ../info/ebrowse ../info/pcl-cvs \
|
||||
../info/woman ../info/emacs-mime ../info/eshell \
|
||||
../info/speedbar ../info/tramp
|
||||
../info/speedbar ../info/tramp ../info/ses
|
||||
DVI_TARGETS = emacs.dvi calc.dvi cc-mode.dvi cl.dvi dired-x.dvi \
|
||||
ediff.dvi forms.dvi gnus.dvi message.dvi mh-e.dvi \
|
||||
reftex.dvi sc.dvi vip.dvi viper.dvi widget.dvi faq.dvi \
|
||||
ada-mode.dvi autotype.dvi idlwave.dvi eudc.dvi ebrowse.dvi \
|
||||
pcl-cvs.dvi woman.dvi emacs-mime.dvi eshell.dvi \
|
||||
speedbar.dvi tramp.dvi
|
||||
speedbar.dvi tramp.dvi ses.dvi
|
||||
INFOSOURCES = info.texi
|
||||
|
||||
# The following rule does not work with all versions of `make'.
|
||||
|
|
@ -272,6 +272,11 @@ emacs-mime.dvi: emacs-mime.texi
|
|||
tramp.dvi: tramp.texi
|
||||
$(ENVADD) $(TEXI2DVI) ${srcdir}/tramp.texi
|
||||
|
||||
../info/ses: ses.texi
|
||||
cd $(srcdir); $(MAKEINFO) ses.texi
|
||||
ses.dvi: ses.texi
|
||||
$(ENVADD) $(TEXI2DVI) ${srcdir}/ses.texi
|
||||
|
||||
mostlyclean:
|
||||
rm -f *.log *.cp *.fn *.ky *.pg *.vr core *.tp *.core gnustmp.*
|
||||
|
||||
|
|
|
|||
860
man/ses.texi
Normal file
860
man/ses.texi
Normal file
|
|
@ -0,0 +1,860 @@
|
|||
\input texinfo @c -*-texinfo-*-
|
||||
@c %**start of header
|
||||
@setfilename ../info/ses
|
||||
@settitle SES: Simple Emacs Spreadsheet
|
||||
@setchapternewpage off
|
||||
@c %**end of header
|
||||
|
||||
@dircategory Emacs
|
||||
@direntry
|
||||
* SES: (ses). Simple Emacs Spreadsheet
|
||||
@end direntry
|
||||
|
||||
@ifinfo
|
||||
This file documents SES: the Simple Emacs Spreadsheet.
|
||||
|
||||
Copyright @copyright{} 2002 Free Software Foundation, Inc.
|
||||
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.1 or
|
||||
any later version published by the Free Software Foundation; with no
|
||||
Invariant Sections, with the Front-Cover texts being ``A GNU
|
||||
Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the
|
||||
license is included in the section entitled ``GNU Free Documentation
|
||||
License'' in the Emacs manual.
|
||||
|
||||
(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
|
||||
this GNU Manual, like GNU software. Copies published by the Free
|
||||
Software Foundation raise funds for GNU development.''
|
||||
|
||||
This document is part of a collection distributed under the GNU Free
|
||||
Documentation License. If you want to distribute this document
|
||||
separately from the collection, you can do so by adding a copy of the
|
||||
license to the document, as described in section 6 of the license.
|
||||
@end ifinfo
|
||||
|
||||
@finalout
|
||||
|
||||
@titlepage
|
||||
@title SES
|
||||
@subtitle Simple Emacs Spreadsheet
|
||||
@author Jonathan A. Yavner
|
||||
@author @email{jyavner@@engineer.com}
|
||||
|
||||
@comment The following two commands start the copyright page.
|
||||
@page
|
||||
@vskip 0pt plus 1filll
|
||||
@noindent
|
||||
Copyright @copyright{} 2002 Free Software Foundation, Inc.
|
||||
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.1 or
|
||||
any later version published by the Free Software Foundation; with no
|
||||
Invariant Sections, with the Front-Cover texts being ``A GNU
|
||||
Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
|
||||
license is included in the section entitled ``GNU Free Documentation
|
||||
License'' in the Emacs manual.
|
||||
|
||||
(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
|
||||
this GNU Manual, like GNU software. Copies published by the Free
|
||||
Software Foundation raise funds for GNU development.''
|
||||
|
||||
This document is part of a collection distributed under the GNU Free
|
||||
Documentation License. If you want to distribute this document
|
||||
separately from the collection, you can do so by adding a copy of the
|
||||
license to the document, as described in section 6 of the license.
|
||||
@end titlepage
|
||||
|
||||
@contents
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@ifnottex
|
||||
@node Top, Introduction, (dir), (dir)
|
||||
@comment node-name, next, previous, up
|
||||
@top SES: Simple Emacs Spreadsheet
|
||||
|
||||
@display
|
||||
SES is a major mode for GNU Emacs to edit spreadsheet files, which
|
||||
contain a rectangular grid of cells. The cells' values are specified
|
||||
by formulas that can refer to the values of other cells.
|
||||
@end display
|
||||
@end ifnottex
|
||||
|
||||
This (such as @pxref{Top,calc,,calc}) is good.
|
||||
|
||||
To report bugs, send email to @email{jyavner@@engineer.com}.
|
||||
|
||||
@menu
|
||||
* Sales pitch:: Why use SES?
|
||||
* The Basics:: Basic spreadsheet commands
|
||||
* Advanced Features:: Want to know more?
|
||||
* For Gurus:: Want to know @emph{even more}?
|
||||
* Acknowledgements:: Acknowledgements
|
||||
@end menu
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@node Sales Pitch, The Basics, Top, Top
|
||||
@comment node-name, next, previous, up
|
||||
@chapter Sales Pitch
|
||||
|
||||
@itemize @bullet
|
||||
@item Create and edit simple spreadsheets with a minimum of fuss.
|
||||
@item Full undo/redo/autosave.
|
||||
@item Immune to viruses in spreadsheet files.
|
||||
@item Cell formulas are straight Emacs Lisp.
|
||||
@item Printer functions for control of cell appearance.
|
||||
@item Intuitive keystroke commands: C-o = insert row, M-o = insert column, etc.
|
||||
@item ``Spillover'' of lengthy cell values into following blank cells.
|
||||
@item Header line shows column letters or a selected row.
|
||||
@item Completing-read for entering symbols as cell values.
|
||||
@item Cut, copy, and paste can transfer formulas and printer functions.
|
||||
@item Import and export of tab-separated values or tab-separated formulas.
|
||||
@item Plaintext, easily-hacked file format.
|
||||
@end itemize
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@node The Basics, Advanced Features, Sales Pitch, Top
|
||||
@comment node-name, next, previous, up
|
||||
@chapter The Basics
|
||||
|
||||
A @dfn{cell identifier} is a symbol with a column letter and a row
|
||||
number. Cell B7 is the 2nd column of the 7th row. For very wide
|
||||
spreadsheets, there are two column letters: cell AB7 is the 28th
|
||||
column of the 7th row.
|
||||
|
||||
@table @kbd
|
||||
@item j
|
||||
Moves point to cell, specified by identifier (@code{ses-jump}).
|
||||
@end table
|
||||
|
||||
Point is always at the left edge of a cell, or at the empty endline.
|
||||
When mark is inactive, the current cell is underlined. When mark is
|
||||
active, the range is the highlighted rectangle of cells (SES always
|
||||
uses transient mark mode). Drag the mouse from A1 to A3 to create the
|
||||
range A1-A2. Many SES commands operate only on single cells, not
|
||||
ranges.
|
||||
|
||||
@table @kbd
|
||||
@item C-SPC
|
||||
@itemx C-@@
|
||||
Set mark at point (@code{set-mark-command}).
|
||||
|
||||
@item C-g
|
||||
Turn off the mark (@code{keyboard-quit}).
|
||||
|
||||
@item M-h
|
||||
Highlight current row (@code{ses-mark-row}).
|
||||
|
||||
@item S-M-h
|
||||
Highlight current column (@code{ses-mark-column}).
|
||||
|
||||
@item C-x h
|
||||
Highlight all cells (@code{mark-whole-buffer}).
|
||||
@end table
|
||||
|
||||
@menu
|
||||
* Formulas::
|
||||
* Resizing::
|
||||
* Printer functions::
|
||||
* Clearing cells::
|
||||
* Copy/cut/paste::
|
||||
* Customizing SES::
|
||||
@end menu
|
||||
|
||||
@node Formulas, Resizing, The Basics, The Basics
|
||||
@section Cell formulas
|
||||
|
||||
To enter a number into the current cell, just start typing:
|
||||
|
||||
@table @kbd
|
||||
@item 0..9
|
||||
Self-insert a digit (@code{ses-read-cell}).
|
||||
|
||||
@item -
|
||||
Self-insert a negative number (@code{ses-read-cell}).
|
||||
|
||||
@item .
|
||||
Self-insert a fractional number (@code{ses-read-cell}).
|
||||
|
||||
@item "
|
||||
Self-insert a quoted string. The ending double-quote
|
||||
is inserted for you (@code{ses-read-cell}).
|
||||
|
||||
@item (
|
||||
Self-insert an expression. The right-parenthesis is inserted for you
|
||||
(@code{ses-read-cell}). To access another cell's value, just use its
|
||||
identifier in your expression. Whenever the other cell is changed,
|
||||
this cell's formula will be reevaluated. While typing in the
|
||||
expression, you can use @kbd{M-TAB} to complete symbol names.
|
||||
|
||||
@item ' @r{(apostrophe)}
|
||||
Enter a symbol (ses-read-symbol). SES remembers all symbols that have
|
||||
been used as formulas, so you can type just the beginning of a symbol
|
||||
and use @kbd{SPC}, @kbd{TAB}, and @kbd{?} to complete it.
|
||||
@end table
|
||||
|
||||
To enter something else (e.g., a vector), begin with a digit, then
|
||||
erase the digit and type whatever you want.
|
||||
|
||||
@table @kbd
|
||||
@item RET
|
||||
Edit the existing formula in the current cell (@code{ses-edit-cell}).
|
||||
|
||||
@item C-c C-c
|
||||
Force recalculation of the current cell or range (@code{ses-recalculate-cell}).
|
||||
|
||||
@item C-c C-l
|
||||
Recalculate the entire spreadsheet (@code{ses-recalculate-all}).
|
||||
@end table
|
||||
|
||||
@node Resizing, Printer functions, Formulas, The Basics
|
||||
@section Resizing the spreadsheet
|
||||
|
||||
Basic commands:
|
||||
|
||||
@table @kbd
|
||||
@item C-o
|
||||
(@code{ses-insert-row})
|
||||
|
||||
@item M-o
|
||||
(@code{ses-insert-column})
|
||||
|
||||
@item C-k
|
||||
(@code{ses-delete-row})
|
||||
|
||||
@item M-k
|
||||
(@code{ses-delete-column})
|
||||
|
||||
@item w
|
||||
(@code{ses-set-column-width})
|
||||
|
||||
@item TAB
|
||||
Moves point to the next rightward cell, or inserts a new column if
|
||||
already at last cell on line, or inserts a new row if at endline
|
||||
(@code{ses-forward-or-insert}).
|
||||
|
||||
@item C-j
|
||||
Linefeed inserts below the current row and moves to column A
|
||||
(@code{ses-append-row-jump-first-column}).
|
||||
@end table
|
||||
|
||||
Resizing the spreadsheet (unless you're just changing a column width)
|
||||
relocates all the cell-references in formulas so they still refer to
|
||||
the same cells. If a formula mentioned B1 and you insert a new first
|
||||
row, the formula will now mention B2.
|
||||
|
||||
If you delete a cell that a formula refers to, the cell-symbol is
|
||||
deleted from the formula, so @code{(+ A1 B1 C1)} after deleting the third
|
||||
column becomes @code{(+ A1 B1)}. In case this is not what you wanted:
|
||||
|
||||
@table @kbd
|
||||
@item C-_
|
||||
@itemx C-x u
|
||||
Undo previous action (@code{(undo)}).
|
||||
@end table
|
||||
|
||||
|
||||
@node Printer functions, Clearing cells, Resizing, The Basics
|
||||
@section Printer functions
|
||||
|
||||
Printer functions convert binary cell values into the print forms that
|
||||
Emacs will display on the screen.
|
||||
|
||||
A printer can be a format string, like @samp{"$%.2f"}. The result
|
||||
string is right-aligned within the print cell. To get left-alignment,
|
||||
use parentheses: @samp{("$%.2f")}. A printer can also be a
|
||||
one-argument function (a symbol or a lambda), whose result is a string
|
||||
(right-aligned) or list of one string (left-aligned). While typing in
|
||||
a lambda, you can use @kbd{M-TAB} to complete the names of symbols.
|
||||
|
||||
Each cell has a printer. If nil, the column-printer for the cell's
|
||||
column is used. If that is also nil, the default-printer for the
|
||||
spreadsheet is used.
|
||||
|
||||
@table @kbd
|
||||
@item p
|
||||
Enter a printer for current cell or range (@code{ses-read-cell-printer}).
|
||||
|
||||
@item M-p
|
||||
Enter a printer for the current column (@code{ses-read-column-printer}).
|
||||
|
||||
@item C-c C-p
|
||||
Enter the default printer for the spreadsheet
|
||||
(@code{ses-read-default-printer}).
|
||||
@end table
|
||||
|
||||
The @code{ses-read-@r{XXX}-printer} commands have their own minibuffer
|
||||
history, which is preloaded with the set of all printers used in this
|
||||
spreadsheet, plus the standard printers.
|
||||
|
||||
The standard printers are suitable only for cells, not columns or
|
||||
default, because they format the value using the column-printer (or
|
||||
default-printer if nil) and then center the result:
|
||||
|
||||
@table @code
|
||||
@item ses-center
|
||||
Just centering.
|
||||
|
||||
@item ses-center-span
|
||||
Centering with spill-over to following blank cells.
|
||||
|
||||
@item ses-dashfill
|
||||
Centering using dashes (-) instead of spaces.
|
||||
|
||||
@item ses-dashfill-span
|
||||
Centering with dashes and spill-over.
|
||||
|
||||
@item ses-tildefill-span
|
||||
Centering with tildes (~) and spill-over.
|
||||
@end table
|
||||
|
||||
|
||||
@node Clearing cells, Copy/cut/paste, Printer functions, The Basics
|
||||
@section Clearing cells
|
||||
|
||||
These commands set both formula and printer to nil:
|
||||
|
||||
@table @kbd
|
||||
@item DEL
|
||||
Clear cell and move left (@code{ses-clear-cell-backward}).
|
||||
|
||||
@item C-d
|
||||
Clear cell and move right (@code{ses-clear-cell-forward}).
|
||||
@end table
|
||||
|
||||
|
||||
@node Copy/cut/paste, Customizing SES, Clearing cells, The Basics
|
||||
@section Copy, cut, and paste
|
||||
|
||||
The copy functions work on rectangular regions of cells. You can paste the
|
||||
copies into non-SES buffers to export the print text.
|
||||
|
||||
@table @kbd
|
||||
@item M-w
|
||||
@itemx [copy]
|
||||
@itemx [C-insert]
|
||||
Copy the highlighted cells to kill ring and primary clipboard
|
||||
(@code{kill-ring-save}).
|
||||
|
||||
@item [drag-mouse-1]
|
||||
Mark a region and copy it to kill ring and primary clipboard
|
||||
(@code{mouse-set-region}).
|
||||
|
||||
@item [M-drag-mouse-1]
|
||||
Mark a region and copy it to kill ring and secondary clipboard
|
||||
(@code{mouse-set-secondary}).
|
||||
|
||||
@item C-w
|
||||
@itemx [cut]
|
||||
@itemx [S-delete]
|
||||
The cut functions do not actually delete rows or columns - they copy
|
||||
and then clear (@code{ses-kill-override}).
|
||||
|
||||
@item C-y
|
||||
@itemx [S-insert]
|
||||
Paste from kill ring (@code{yank}). The paste functions behave
|
||||
differently depending on the format of the text being inserted:
|
||||
@itemize @bullet
|
||||
@item
|
||||
When pasting cells that were cut from a SES buffer, the print text is
|
||||
ignored and only the attached formula and printer are inserted; cell
|
||||
references in the formula are relocated unless you use @kbd{C-u}.
|
||||
@item
|
||||
The pasted text overwrites a rectangle of cells whose top left corner
|
||||
is the current cell. If part of the rectangle is beyond the edges of
|
||||
the spreadsheet, you must confirm the increase in spreadsheet size.
|
||||
@item
|
||||
Non-SES text is usually inserted as a replacement formula for the
|
||||
current cell. If the formula would be a symbol, it's treated as a
|
||||
string unless you use @kbd{C-u}. Pasted formulas with syntax errors
|
||||
are always treated as strings.
|
||||
@end itemize
|
||||
|
||||
@item [paste]
|
||||
Paste from primary clipboard or kill ring (@code{clipboard-yank}).
|
||||
|
||||
@item [mouse-2]
|
||||
Set point and paste from primary clipboard (@code{mouse-yank-at-click}).
|
||||
|
||||
@item [M-mouse-2]
|
||||
Set point and paste from secondary clipboard (@code{mouse-yank-secondary}).
|
||||
|
||||
@item M-y
|
||||
Immediately after a paste, you can replace the text with a preceding
|
||||
element from the kill ring (@code{ses-yank-pop}). Unlike the standard
|
||||
Emacs yank-pop, the SES version uses @code{undo} to delete the old
|
||||
yank. This doesn't make any difference?
|
||||
@end table
|
||||
|
||||
@node Customizing SES, , Copy/cut/paste, The Basics
|
||||
@section Customizing SES
|
||||
|
||||
By default, a newly-created spreadsheet has 1 row and 1 column. The
|
||||
column width is 7 and the default printer is @samp{"%.7g"}. Each of these
|
||||
can be customized. Look in group ``ses''.
|
||||
|
||||
After entering a cell value, point normally moves right to the next
|
||||
cell. You can customize @code{ses-after-entry-functions} to move left or
|
||||
up or down. For diagonal movement, select two functions from the
|
||||
list.
|
||||
|
||||
@code{ses-mode-hook} is a normal mode hook (list of functions to
|
||||
execute when starting SES mode for a buffer).
|
||||
|
||||
The variable @code{safe-functions} is a a list of possibly-unsafe
|
||||
functions to be treated as safe when analysing formulas and printers.
|
||||
@xref{Virus protection}. Before customizing @code{safe-functions},
|
||||
think about how much you trust the person who's suggesting this
|
||||
change. The value t turns off all anti-virus protection. A
|
||||
list-of-functions value might enable a ``gee whiz'' spreadsheet, but it
|
||||
also creates trapdoors in your anti-virus armor. In order for virus
|
||||
protection to work, you must always press @kbd{n} when presented with
|
||||
a virus warning, unless you understand what the questionable code is
|
||||
trying to do. Do not listen to those who tell you to customize
|
||||
@code{enable-local-eval}---this variable is for people who don't wear
|
||||
safety belts!
|
||||
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@node Advanced Features, For Gurus, The Basics, Top
|
||||
@chapter Advanced Features
|
||||
|
||||
@table @kbd
|
||||
@item C-c M-C-h
|
||||
(@code{ses-read-header-row}). The header line at the top of the SES
|
||||
window normally shows the column letter for each column. You can set
|
||||
it to show a copy of some row, such as a row of column titles, so that
|
||||
row will always be visible. Set the header line to row 0 to show
|
||||
column letters again.
|
||||
@end table
|
||||
|
||||
@menu
|
||||
* The print area::
|
||||
* Ranges in formulas::
|
||||
* Sorting by column::
|
||||
* Standard formula functions::
|
||||
* More on cell printing::
|
||||
* Import and export::
|
||||
* Virus protection::
|
||||
* Spreadsheets with details and summary::
|
||||
@end menu
|
||||
|
||||
@node The print area, Ranges in formulas, Advanced Features, Advanced Features
|
||||
@section The print area
|
||||
|
||||
A SES file consists of a print area and a data area. Normally the
|
||||
buffer is narrowed to show only the print area. The print area is
|
||||
read-only except for special SES commands; it contains cell values
|
||||
formatted by printer functions. The data area records the formula and
|
||||
printer functions, etc.
|
||||
|
||||
@table @kbd
|
||||
@item C-x n w
|
||||
Show print and data areas (@code{widen}).
|
||||
|
||||
@item C-c C-n
|
||||
Show only print area (@code{ses-renarrow-buffer}).
|
||||
|
||||
@item S-C-l
|
||||
@itemx M-C-l
|
||||
Recreate print area by reevaluating printer functions for all cells
|
||||
(@code{ses-reprint-all}).
|
||||
@end table
|
||||
|
||||
@node Ranges in formulas, Sorting by column, The print area, Advanced Features
|
||||
@section Ranges in formulas
|
||||
|
||||
A formula like
|
||||
@lisp
|
||||
(+ A1 A2 A3)
|
||||
@end lisp
|
||||
is the sum of three specific cells. If you insert a new second row,
|
||||
the formula becomes
|
||||
@lisp
|
||||
(+ A1 A3 A4)
|
||||
@end lisp
|
||||
and the new row is not included in the sum.
|
||||
|
||||
The macro @code{(ses-range @var{from} @var{to})} evalutes to a list of
|
||||
the values in a rectangle of cells. If your formula is
|
||||
@lisp
|
||||
(apply '+ (ses-range A1 A3))
|
||||
@end lisp
|
||||
and you insert a new second row, it becomes
|
||||
@lisp
|
||||
(apply '+ (ses-range A1 A4))
|
||||
@end lisp
|
||||
and the new row is included in the sum.
|
||||
|
||||
While entering or editing a formula in the minibuffer, you can select
|
||||
a range in the spreadsheet (using mouse or keyboard), then paste a
|
||||
representation of that range into your formula. Suppose you select
|
||||
A1-C1:
|
||||
|
||||
@table @kbd
|
||||
@item [S-mouse-3]
|
||||
Inserts "A1 B1 C1" @code{(ses-insert-range-click})
|
||||
|
||||
@item C-c C-r
|
||||
Keyboard version (@code{ses-insert-range}).
|
||||
|
||||
@item [C-S-mouse-3]
|
||||
Inserts "(ses-range A1 C1)" (@code{ses-insert-ses-range-click}).
|
||||
|
||||
@item C-c C-s
|
||||
Keyboard version (@code{ses-insert-ses-range}).
|
||||
@end table
|
||||
|
||||
If you delete the @var{from} or @var{to} cell for a range, the nearest
|
||||
still-existing cell is used instead. If you delete the entire range,
|
||||
the formula relocator will delete the ses-range from the formula.
|
||||
|
||||
If you insert a new row just beyond the end of a one-column range, or
|
||||
a new column just beyond a one-row range, the new cell is included in
|
||||
the range. New cells inserted just before a range are not included.
|
||||
|
||||
|
||||
@node Sorting by column, Standard formula functions, Ranges in formulas, Advanced Features
|
||||
@section Sorting by column
|
||||
|
||||
@table @kbd
|
||||
@item C-c M-C-s
|
||||
Sort the cells of a range using one of the columns
|
||||
(@code{ses-sort-column}). The rows (or partial rows if the range
|
||||
doesn't include all columns) are rearranged so the chosen column will
|
||||
be in order.
|
||||
|
||||
@item [header-line mouse-2]
|
||||
The easiest way to sort is to click mouse-2 on the chosen column's header row
|
||||
(@code{ses-sort-column-click}).
|
||||
@end table
|
||||
|
||||
The sort comparison uses @code{string<}, which works well for
|
||||
right-justified numbers and left-justified strings.
|
||||
|
||||
With prefix arg, sort is in descending order.
|
||||
|
||||
Rows are moved one at a time, with relocation of formulas. This works
|
||||
well if formulas refer to other cells in their row, not so well for
|
||||
formulas that refer to other rows in the range or to cells outside the
|
||||
range.
|
||||
|
||||
|
||||
@node Standard formula functions, More on cell printing, Sorting by column, Advanced Features
|
||||
@section Standard formula functions
|
||||
|
||||
Oftentimes you want a calculation to exclude the blank cells. Here
|
||||
are some useful functions to call from your formulas:
|
||||
|
||||
@table @code
|
||||
@item (ses-delete-blanks &rest @var{args})
|
||||
Returns a list from which all blank cells (value is either nil or
|
||||
'*skip*) have been deleted.
|
||||
|
||||
@item (ses+ &rest @var{args})
|
||||
Sum of non-blank arguments.
|
||||
|
||||
@item (ses-average @var{list})
|
||||
Average of non-blank elements in @var{list}. Here the list is passed
|
||||
as a single argument, since you'll probably use it with @code{ses-range}.
|
||||
@end table
|
||||
|
||||
@node More on cell printing, Import and export, Standard formula functions, Advanced Features
|
||||
@section More on cell printing
|
||||
|
||||
Special cell values:
|
||||
@itemize
|
||||
@item nil prints the same as "", but allows previous cell to spill over.
|
||||
@item '*skip* replaces nil when the previous cell actually does spill over;
|
||||
nothing is printed for it.
|
||||
@item '*error* indicates that the formula signalled an error instead of
|
||||
producing a value: the print cell is filled with hash marks (#).
|
||||
@end itemize
|
||||
|
||||
If the result from the printer function is too wide for the cell and
|
||||
the following cell is nil, the result will spill over into the
|
||||
following cell. Very wide results can spill over several cells. If
|
||||
the result is too wide for the available space (up to the end of the
|
||||
row or the next non-nil cell), the result is truncated if the cell's
|
||||
value is a string, or replaced with hash marks otherwise.
|
||||
|
||||
SES could get confused by printer results that contain newlines or
|
||||
tabs, so these are replaced with question marks.
|
||||
|
||||
@table @kbd
|
||||
@item C-c C-t
|
||||
Confine a cell to its own column (@code{ses-truncate-cell}). This
|
||||
alows you to move point to a rightward cell that would otherwise be
|
||||
covered by a spill-over. If you don't change the rightward cell, the
|
||||
confined cell will spill over again the next time it is reprinted.
|
||||
|
||||
@item C-c C-c
|
||||
When applied to a single cell, this command displays in the echo area any
|
||||
formula error or printer error that occurred during
|
||||
recalculation/reprinting (@code{ses-recalculate-cell}).
|
||||
@end table
|
||||
|
||||
When a printer function signals an error, the default printer
|
||||
@samp{"%s"} is substituted. This is useful when your column printer
|
||||
is numeric-only and you use a string as a cell value.
|
||||
|
||||
|
||||
@node Import and export, Virus protection, More on cell printing, Advanced Features
|
||||
@section Import and export
|
||||
|
||||
@table @kbd
|
||||
@item x t
|
||||
Export a range of cells as tab-separated values (@code{ses-export-tsv}).
|
||||
@item x T
|
||||
Export a range of cells as tab-separated formulas (@code{ses-export-tsf}).
|
||||
@end table
|
||||
|
||||
The exported text goes to the kill ring --- you can paste it into
|
||||
another buffer. Columns are separated by tabs, rows by newlines.
|
||||
|
||||
To import text, use any of the yank commands where the text to paste
|
||||
contains tabs and/or newlines. Imported formulas are not relocated.
|
||||
|
||||
@node Virus protection, Spreadsheets with details and summary, Import and export, Advanced Features
|
||||
@section Virus protection
|
||||
|
||||
Whenever a formula or printer is read from a file or is pasted into
|
||||
the spreadsheet, it receives a ``needs safety check'' marking. Later,
|
||||
when the formula or printer is evaluated for the first time, it is
|
||||
checked for safety using the @code{unsafep} predicate; if found to be
|
||||
``possibly unsafe'', the questionable formula or printer is displayed
|
||||
and you must press Y to approve it or N to use a substitute. The
|
||||
substitute always signals an error.
|
||||
|
||||
Formulas or printers that you type in are checked immediately for
|
||||
safety. If found to be possibly unsafe and you press N to disapprove,
|
||||
the action is cancelled and the old formula or printer will remain.
|
||||
|
||||
Besides viruses (which try to copy themselves to other files),
|
||||
@code{unsafep} can also detect all other kinds of Trojan horses, such as
|
||||
spreadsheets that delete files, send email, flood Web sites, alter
|
||||
your Emacs settings, etc.
|
||||
|
||||
Generally, spreadsheet formulas and printers are simple things that
|
||||
don't need to do any fancy computing, so all potentially-dangerous
|
||||
parts of the Emacs Lisp environment can be excluded without cramping
|
||||
your style as a formula-writer. See the documentation in @file{unsafep.el}
|
||||
for more info on how Lisp forms are classified as safe or unsafe.
|
||||
|
||||
@node Spreadsheets with details and summary, , Virus protection, Advanced Features
|
||||
@section Spreadsheets with details and summary
|
||||
|
||||
A common organization for spreadsheets is to have a bunch of ``detail''
|
||||
rows, each perhaps describing a transaction, and then a set of
|
||||
``summary'' rows that each show reduced data for some subset of the
|
||||
details. SES supports this organization via the @code{ses-select}
|
||||
function.
|
||||
|
||||
@table @code
|
||||
@item (ses-select @var{fromrange} @var{test} @var{torange})
|
||||
Returns a subset of @var{torange}. For each member in @var{fromrange}
|
||||
that is equal to @var{test}, the corresponding member of @var{torange}
|
||||
is included in the result.
|
||||
@end table
|
||||
|
||||
Example of use:
|
||||
@lisp
|
||||
(ses-average (ses-select (ses-range A1 A5) 'Smith (ses-range B1 B5)))
|
||||
@end lisp
|
||||
This computes the average of the B column values for those rows whose
|
||||
A column value is the symbol 'Smith.
|
||||
|
||||
Arguably one could specify only @var{fromrange} plus
|
||||
@var{to-row-offset} and @var{to-column-offset}. The @var{torange} is
|
||||
stated explicitly to ensure that the formula will be recalculated if
|
||||
any cell in either range is changed.
|
||||
|
||||
File @file{etc/ses-example.el} in the Emacs distribution is an example of a
|
||||
details-and-summary spreadsheet.
|
||||
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@node For Gurus, Acknowledgements, Advanced Features, Top
|
||||
@chapter For Gurus
|
||||
|
||||
@menu
|
||||
* Deferred updates::
|
||||
* Nonrelocatable references::
|
||||
* The data area::
|
||||
* Buffer-local variables in spreadsheets::
|
||||
* Uses of defadvice in SES::
|
||||
@end menu
|
||||
|
||||
@node Deferred updates, Nonrelocatable references, For Gurus, For Gurus
|
||||
@section Deferred updates
|
||||
|
||||
To save time by avoiding redundant computations, cells that need
|
||||
recalculation due to changes in other cells are added to a set. At
|
||||
the end of the command, each cell in the set is recalculated once.
|
||||
This can create a new set of cells that need recalculation. The
|
||||
process is repeated until either the set is empty or it stops changing
|
||||
(due to circular references among the cells). In extreme cases, you
|
||||
might see progress messages of the form ``Recalculating... (@var{nnn}
|
||||
cells left)''. If you interrupt the calculation using @kbd{C-g}, the
|
||||
spreadsheet will be left in an inconsistent state, so use @kbd{C-_} or
|
||||
@kbd{C-c C-l} to fix it.
|
||||
|
||||
To save even more time by avoiding redundant writes, cells that have
|
||||
changes are added to a set instead of being written immediately to the
|
||||
data area. Each cell in the set is written once, at the end of the
|
||||
command. If you change vast quantities of cells, you might see a
|
||||
progress message of the form ``Writing... (@var{nnn} cells left)''.
|
||||
These deferred cell-writes cannot be interrupted by @kbd{C-g}, so
|
||||
you'll just have to wait.
|
||||
|
||||
SES uses @code{run-with-idle-timer} to move the cell underline when
|
||||
Emacs will be scrolling the buffer after the end of a command, and
|
||||
also to narrow and underline after @kbd{C-x C-v}. This is visible as
|
||||
a momentary glitch after C-x C-v and certain scrolling commands. You
|
||||
can type ahead without worrying about the glitch.
|
||||
|
||||
|
||||
@node Nonrelocatable references, The data area, Deferred updates, For Gurus
|
||||
@section Nonrelocatable references
|
||||
|
||||
@kbd{C-y} relocates all cell-references in a pasted formula, while
|
||||
@kbd{C-u C-y} relocates none of the cell-references. What about mixed
|
||||
cases?
|
||||
|
||||
You can use
|
||||
@lisp
|
||||
(symbol-value 'B3)
|
||||
@end lisp
|
||||
to make an @dfn{absolute reference}. The formula relocator skips over
|
||||
quoted things, so this will not be relocated when pasted or when
|
||||
rows/columns are inserted/deleted. However, B3 will not be recorded
|
||||
as a dependency of this cell, so this cell will not be updated
|
||||
automatically when B3 is changed.
|
||||
|
||||
The variables @code{row} and @code{col} are dynamically bound while a
|
||||
cell formula is being evaluated. You can use
|
||||
@lisp
|
||||
(ses-cell-value row 0)
|
||||
@end lisp
|
||||
to get the value from the leftmost column in the current row. This
|
||||
kind of dependency is also not recorded.
|
||||
|
||||
|
||||
@node The data area, Buffer-local variables in spreadsheets, Nonrelocatable references, For Gurus
|
||||
@section The data area
|
||||
|
||||
Begins with an 014 character, followed by sets of cell-definition
|
||||
macros for each row, followed by column-widths, column-printers,
|
||||
default-printer, and header-row. Then there's the global parameters
|
||||
(file-format ID, numrows, numcols) and the local variables (specifying
|
||||
SES mode for the buffer, etc.)
|
||||
|
||||
When a SES file is loaded, first the numrows and numcols values are
|
||||
loaded, then the entire data area is @code{eval}ed, and finally the local
|
||||
variables are processed.
|
||||
|
||||
You can edit the data area, but don't insert or delete any newlines
|
||||
except in the local-variables part, since SES locates things by
|
||||
counting newlines. Use @kbd{C-x C-e} at the end of a line to install
|
||||
your edits into the spreadsheet data structures (this does not update
|
||||
the print area, use e.g. @kbd{C-c C-l} for that).
|
||||
|
||||
The data area is maintained as an image of spreadsheet data
|
||||
structures that area stored in buffer-local variables. If the data
|
||||
area gets messed up, you can try reconstructing the data area from the
|
||||
data structures:
|
||||
|
||||
@table @kbd
|
||||
@item C-c M-C-l
|
||||
(@code{ses-reconstruct-all}).
|
||||
@end table
|
||||
|
||||
|
||||
@node Buffer-local variables in spreadsheets, Uses of defadvice in SES, The data area, For Gurus
|
||||
@section Buffer-local variables in spreadsheets
|
||||
|
||||
You can add additional local variables to the list at the bottom of
|
||||
the data area, such as hidden constants you want to refer to in your
|
||||
formulas.
|
||||
|
||||
You can override the variable @code{symbolic-formulas} to be a list of
|
||||
symbols (as parenthesized strings) to show as completions for the '
|
||||
command. This initial completions list is used instead of the actual
|
||||
set of symbols-as-formulas in the spreadsheet.
|
||||
|
||||
For examples of these, see file @file{etc/ses-example.ses}.
|
||||
|
||||
If (for some reason) you want your formulas or printers to save data
|
||||
into variables, you must declare these variables as buffer-locals in
|
||||
order to avoid a virus warning.
|
||||
|
||||
You can define functions by making them values for the fake local
|
||||
variable @code{eval}. Such functions can then be used in your
|
||||
formulas and printers, but usually each @code{eval} is presented to
|
||||
the user during file loading as a potential virus --- this can get
|
||||
annoying.
|
||||
|
||||
You can define functions in your @file{.emacs} file. Other people can
|
||||
still read the print area of your spreadsheet, but they won't be able
|
||||
to recalculate or reprint anything that depends on your functions. To
|
||||
avoid virus warnings, each function used in a formula needs
|
||||
@lisp
|
||||
(put 'your-function-name 'safe-function t)
|
||||
@end lisp
|
||||
|
||||
@node Uses of defadvice in SES, , Buffer-local variables in spreadsheets, For Gurus
|
||||
@section Uses of defadvice in SES
|
||||
|
||||
@table @code
|
||||
@item undo-more
|
||||
Defines a new undo element format (@var{fun} . @var{args}), which
|
||||
means ``undo by applying @var{fun} to @var{args}''. For spreadsheet
|
||||
buffers, it allows undos in the data area even though that's outside
|
||||
the narrowing.
|
||||
|
||||
@item copy-region-as-kill
|
||||
When copying from the print area of a spreadsheet, treat the region as
|
||||
a rectangle and attach each cell's formula and printer as 'ses
|
||||
properties.
|
||||
|
||||
@item yank
|
||||
When yanking into the print area of a spreadsheet, first try to yank
|
||||
as cells (if the yank text has 'ses properties), then as tab-separated
|
||||
formulas, then (if all else fails) as a single formula for the current
|
||||
cell.
|
||||
@end table
|
||||
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@node Acknowledgements, , For Gurus, Top
|
||||
@chapter Acknowledgements
|
||||
|
||||
@quotation
|
||||
Christoph Conrad @email{christoph.conrad@@gmx.de}@*
|
||||
CyberBob @email{cyberbob@@redneck.gacracker.org}@*
|
||||
Syver Enstad @email{syver-en@@online.no}@*
|
||||
Ami Fischman @email{fischman@@zion.bpnetworks.com}@*
|
||||
Thomas Gehrlein @email{Thomas.Gehrlein@@t-online.de}@*
|
||||
Chris F.A. Johnson @email{c.f.a.johnson@@rogers.com}@*
|
||||
Yusong Li @email{lyusong@@hotmail.com}@*
|
||||
Yuri Linkov @email{link0ff@@yahoo.com}@*
|
||||
Harald Maier @email{maierh@@myself.com}@*
|
||||
Alan Nash @email{anash@@san.rr.com}@*
|
||||
François Pinard @email{pinard@@iro.umontreal.ca}@*
|
||||
Pedro Pinto @email{ppinto@@cs.cmu.edu}@*
|
||||
Stefan Reichör @email{xsteve@@riic.at}@*
|
||||
Oliver Scholz @email{epameinondas@@gmx.de}@*
|
||||
Richard M. Stallman @email{rms@@gnu.org}@*
|
||||
J. Otto Tennant @email{jotto@@pobox.com}@*
|
||||
Jean-Philippe Theberge @email{jphil@@acs.pagesjaunes.fr}
|
||||
@end quotation
|
||||
|
||||
@c ===================================================================
|
||||
|
||||
@bye
|
||||
Loading…
Add table
Reference in a new issue