3 ;;; Time-stamp: <2012-10-09 04:39:58 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
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.
24 ;;; Listing and Saving Variables and Functions (XLispStat compatibility)
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
*
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
*))
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
))
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
))
71 (defun variables-list ()
72 "Return list of variables as a lisp list of strings."
73 (mapcar #'intern
(sort-data (mapcar #'string
*variables
*))))
77 Returns a list of the names of all def'ed variables to STREAM"
79 (mapcar #'intern
(sort-data (mapcar #'string
*variables
*)))))
83 (defgeneric undef2
(v)
84 (:documentation
"generic version of the XLS-1 `undef` function.")
85 (:method
((v symbol
)))
86 (:method
((v sequence
)))) ;; FIXME: a sequence/list of symbols
88 ;; (and list (satifies symbol)) ?? NO.
93 If V is the symbol of a defined variable the variable it is unbound and
94 removed from the list of defined variables. If V is a list of variable
95 names each is unbound and removed. Returns V."
96 (dolist (s (if (listp v
) v
(list v
)))
97 (when (member s
*variables
*)
98 (setq *variables
* (delete s
*variables
*))
102 (defun read-data-file (&optional
(file (open-file-dialog)))
104 Returns a list of all lisp objects in FILE. FILE can be a string or a symbol,
105 in which case the symbol'f print name is used."
107 (let ((eof (gensym)))
108 (with-open-file (f file
)
110 (do* ((r (read f nil eof
) (read f nil eof
))
114 (setf (cdr tail
) (list r
))))))))
116 ;;; New definition to avoid stack size limit in apply
118 (defun read-data-columns (&optional
(file (open-file-dialog))
120 (count-file-columns file
))))
121 "Args: (&optional file cols)
122 Reads the data in FILE as COLS columns and returns a list of lists representing the columns."
124 (transpose (split-list (read-data-file file
) cols
))))
127 ;;; FIXME:AJR: ALL THE FOLLOWING NEED TO BE SOLVED BY PLATFORM-INDEP PATHNAME WORK!
128 ;;; FIXME:AJR: use either string or pathname.
130 (defun path-string-to-path (p s
)
131 (pathname (concatenate 'string
(namestring p
) s
)))
133 (defun load-data (file)
134 "Args: (file) as string
135 Read in data file from the System DATA library."
136 (if (load (path-string-to-path *cls-data-dir
* file
))
138 (load (path-string-to-path *cls-data-dir
* file
))))
140 (defun load-example (file)
141 "Args: (file) as string
142 Read in lisp example file from the System EXAMPLES library."
143 (if (load (path-string-to-path cls-config
:*cls-examples-dir
* file
))
145 (load (path-string-to-path cls-config
:*cls-examples-dir
* file
))))
148 ;;; Saving Variables and Functions
151 (defun savevar (vars file
&optional
(suffix ".lsp"))
152 "Args: (vars-symbol-or-list file-name-root &optional suffix-string)
154 VARS is a symbol or a list of symbols. FILE-NAME-ROOT is a string (or
155 a symbol whose print name is used) not ending in SUFFIX (defaults to
156 \".lsp\"). The VARS and their current values are written to the file
157 FILE-NAME-ROOT.lsp in a form suitable for use with the load command."
158 (with-open-file (f (concatenate 'string
(namestring file
) suffix
)
160 (let ((vars (if (consp vars
) vars
(list vars
))))
162 (let ((v (symbol-value x
)))
164 (format f
"(def ~s ~s)~%" x
(send v
:save
))
165 (format f
"(def ~s '~s)~%" x v
)))))
166 (mapcar #'save-one vars
))