fcn VARIABLES needs to include name of package which external's the data variable...
[CommonLispStat.git] / src / data / data-xls-compat.lisp
blob80212c2e3f4814804b00c617033a1fd6a5996d5e
1 ;;; -*- mode: lisp -*-
3 ;;; Time-stamp: <2012-10-11 14:39:04 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 (name value &optional (documentation nil documentation-p))
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 (declaim (special ,name))
37 (unless (and *ask-on-redefine*
38 (boundp ',name)
39 (not (y-or-n-p "Variable has a value. Redefine?")))
40 ,(when documentation-p
41 `(setf (documentation ',name 'variable) ',documentation))
42 (setf (symbol-value ',name) ,value)
43 (pushnew ',name *variables*))
44 ',name))
47 ;; (def *mydef* (list 1 2 3 4 5))
49 #| Taken from the CLHS, for use in getting the DEF XLS-compat function right.
50 defparameter and defvar might be defined as follows:
52 (defmacro defparameter (name initial-value
53 &optional (documentation nil documentation-p))
54 `(progn (declaim (special ,name))
55 (setf (symbol-value ',name) ,initial-value)
56 ,(when documentation-p
57 `(setf (documentation ',name 'variable) ',documentation))
58 ',name))
59 (defmacro defvar (name &optional
60 (initial-value nil initial-value-p)
61 (documentation nil documentation-p))
62 `(progn (declaim (special ,name))
63 ,(when initial-value-p
64 `(unless (boundp ',name)
65 (setf (symbol-value ',name) ,initial-value)))
66 ,(when documentation-p
67 `(setf (documentation ',name 'variable) ',documentation))
68 ',name))
71 (defun variables-list ()
72 "Return list of variables as a lisp list of strings."
73 (mapcar #'intern (sort-data (mapcar #'string *variables*))))
75 (defun variables ()
76 "Args:()
77 Returns a list of the names of all def'ed variables to STREAM.
79 FIXME: THIS IS BROKEN -- NEEDS TO ALSO PROVIDE PACKAGE LOCATION AS WELL!!"
80 (if *variables*
81 (mapcar #'intern (sort-data (mapcar #'string *variables*)))))
85 (defgeneric undef2 (v)
86 (:documentation "generic version of the XLS-1 `undef` function.")
87 (:method ((v symbol)))
88 (:method ((v sequence)))) ;; FIXME: a sequence/list of symbols
89 ;; (vector symbol *)
90 ;; (and list (satifies symbol)) ?? NO.
93 (defun undef (v)
94 "Args: (v)
95 If V is the symbol of a defined variable the variable it is unbound and
96 removed from the list of defined variables. If V is a list of variable
97 names each is unbound and removed. Returns V."
98 (dolist (s (if (listp v) v (list v)))
99 (when (member s *variables*)
100 (setq *variables* (delete s *variables*))
101 (makunbound s)))
104 (defun read-data-file (&optional (file (open-file-dialog)))
105 "Args: (file)
106 Returns a list of all lisp objects in FILE. FILE can be a string or a symbol,
107 in which case the symbol'f print name is used."
108 (if file
109 (let ((eof (gensym)))
110 (with-open-file (f file)
111 (if f
112 (do* ((r (read f nil eof) (read f nil eof))
113 (x (list nil))
114 (tail x (cdr tail)))
115 ((eq r eof) (cdr x))
116 (setf (cdr tail) (list r))))))))
118 ;;; New definition to avoid stack size limit in apply
120 (defun read-data-columns (&optional (file (open-file-dialog))
121 (cols (if file
122 (count-file-columns file))))
123 "Args: (&optional file cols)
124 Reads the data in FILE as COLS columns and returns a list of lists representing the columns."
125 (if (and file cols)
126 (transpose (split-list (read-data-file file) cols))))
129 ;;; FIXME:AJR: ALL THE FOLLOWING NEED TO BE SOLVED BY PLATFORM-INDEP PATHNAME WORK!
130 ;;; FIXME:AJR: use either string or pathname.
132 (defun path-string-to-path (p s)
133 (pathname (concatenate 'string (namestring p) s)))
135 (defun load-data (file)
136 "Args: (file) as string
137 Read in data file from the System DATA library. Return true if success, failure value otherwise."
138 (if (load (path-string-to-path *cls-data-dir* file) :verbose T :print T)
140 (load (path-string-to-path *cls-data-dir* file) :verbose T :print T)))
142 (defun load-example (file)
143 "Args: (file) as string
144 Read in lisp example file from the System EXAMPLES library."
145 (if (load (path-string-to-path cls-config:*cls-examples-dir* file))
147 (load (path-string-to-path cls-config:*cls-examples-dir* file))))
150 ;;; Saving Variables and Functions
153 (defun savevar (vars file &optional (suffix ".lsp"))
154 "Args: (vars-symbol-or-list file-name-root &optional suffix-string)
156 VARS is a symbol or a list of symbols. FILE-NAME-ROOT is a string (or
157 a symbol whose print name is used) not ending in SUFFIX (defaults to
158 \".lsp\"). The VARS and their current values are written to the file
159 FILE-NAME-ROOT.lsp in a form suitable for use with the load command."
160 (with-open-file (f (concatenate 'string (namestring file) suffix)
161 :direction :output)
162 (let ((vars (if (consp vars) vars (list vars))))
163 (flet ((save-one (x)
164 (let ((v (symbol-value x)))
165 (if (objectp v)
166 (format f "(def ~s ~s)~%" x (send v :save))
167 (format f "(def ~s '~s)~%" x v)))))
168 (mapcar #'save-one vars))
169 vars)))