[CommonLispStat.git] / src / data / data-xls-compat.lisp
1 ;;; -*- mode: lisp -*-
3 ;;; Time-stamp: <2009-12-23 14:18:47 tony>
4 ;;; Creation: <2009-03-12 17:14:56 tony>
5 ;;; File: template.lisp
6 ;;; Author: AJ Rossini <blindglobe@gmail.com>
7 ;;; Copyright: (c)2009--, AJ Rossini. Currently licensed under MIT
8 ;;; license. See file LICENSE.mit in top-level directory
9 ;;; for information.
10 ;;; Purpose: Template header file
12 ;;; What is this talk of 'release'? Klingons do not make software
13 ;;; 'releases'. Our software 'escapes', leaving a bloody trail of
14 ;;; designers and quality assurance people in its wake.
16 ;;; This organization and structure is new to the 21st Century
17 ;;; version.. Think, "21st Century Schizoid Man".
19 (in-package :lisp-stat-data)
21 ;; XLISPSTAT compatibility functions.
23 ;;;;
24 ;;;; Listing and Saving Variables and Functions (XLispStat compatibility)
25 ;;;;
27 (defvar *variables* nil)
28 (defvar *ask-on-redefine* nil)
30 (defmacro def (symbol value)
31 "Syntax: (def var form)
32 VAR is not evaluated and must be a symbol. Assigns the value of FORM to
33 VAR and adds VAR to the list *VARIABLES* of def'ed variables. Returns VAR.
34 If VAR is already bound and the global variable *ASK-ON-REDEFINE*
35 is not nil then you are asked if you want to redefine the variable."
36 `(progn
37 (unless (and *ask-on-redefine*
38 (boundp ',symbol)
39 (not (y-or-n-p "Variable has a value. Redefine?")))
40 (defparameter ,symbol ,value))
41 (pushnew ',symbol *variables*)
42 ',symbol))
44 (defun variables-list ()
45 "Return list of variables as a lisp list of strings."
46 (mapcar #'intern (sort-data (mapcar #'string *variables*))))
48 (defun variables ()
49 "Args:()
50 Returns a list of the names of all def'ed variables to STREAM"
51 (if *variables*
52 (mapcar #'intern (sort-data (mapcar #'string *variables*)))))
55 (defun undef (v)
56 "Args: (v)
57 If V is the symbol of a defined variable the variable it is unbound and
58 removed from the list of defined variables. If V is a list of variable
59 names each is unbound and removed. Returns V."
60 (dolist (s (if (listp v) v (list v)))
61 (when (member s *variables*)
62 (setq *variables* (delete s *variables*))
63 (makunbound s)))
66 (defun read-data-file (&optional (file (open-file-dialog)))
67 "Args: (file)
68 Returns a list of all lisp objects in FILE. FILE can be a string or a symbol,
69 in which case the symbol'f print name is used."
70 (if file
71 (let ((eof (gensym)))
72 (with-open-file (f file)
73 (if f
74 (do* ((r (read f nil eof) (read f nil eof))
75 (x (list nil))
76 (tail x (cdr tail)))
77 ((eq r eof) (cdr x))
78 (setf (cdr tail) (list r))))))))
80 ;;; New definition to avoid stack size limit in apply
82 (defun read-data-columns (&optional (file (open-file-dialog))
83 (cols (if file
84 (count-file-columns file))))
85 "Args: (&optional file cols)
86 Reads the data in FILE as COLS columns and returns a list of lists representing the columns."
87 (if (and file cols)
88 (transpose (split-list (read-data-file file) cols))))
92 ;;; FIXME:AJR: use either string or pathname.
94 (defun path-string-to-path (p s)
95 (pathname (concatenate 'string (namestring p) s)))
97 (defun load-data (file)
98 "Args: (file) as string
99 Read in data file from the System DATA library."
100 (if (load (path-string-to-path *cls-data-dir* file))
102 (load (path-string-to-path *cls-data-dir* file))))
104 (defun load-example (file)
105 "Args: (file) as string
106 Read in lisp example file from the System EXAMPLES library."
107 (if (load (path-string-to-path cls-config:*cls-examples-dir* file))
109 (load (path-string-to-path cls-config:*cls-examples-dir* file))))
112 ;;; Saving Variables and Functions
115 (defun savevar (vars file &optional (suffix ".lsp"))
116 "Args: (vars-symbol-or-list file-name-root &optional suffix-string)
118 VARS is a symbol or a list of symbols. FILE-NAME-ROOT is a string (or
119 a symbol whose print name is used) not ending in SUFFIX (defaults to
120 \".lsp\"). The VARS and their current values are written to the file
121 FILE-NAME-ROOT.lsp in a form suitable for use with the load command."
122 (with-open-file (f (concatenate 'string (namestring file) suffix)
123 :direction :output)
124 (let ((vars (if (consp vars) vars (list vars))))
125 (flet ((save-one (x)
126 (let ((v (symbol-value x)))
127 (if (objectp v)
128 (format f "(def ~s ~s)~%" x (send v :save))
129 (format f "(def ~s '~s)~%" x v)))))
130 (mapcar #'save-one vars))
131 vars)))