fixed DEF to work correctly, finally, with docs from where I coded it.
[CommonLispStat.git] / src / data / data-xls-compat.lisp
1 ;;; -*- mode: lisp -*-
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 <>
7 ;;; Copyright: (c)2009--, AJ Rossini. Currently licensed under MIT
8 ;;; license. See file 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"
78 (if *variables*
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
87 ;; (vector symbol *)
88 ;; (and list (satifies symbol)) ?? NO.
91 (defun undef (v)
92 "Args: (v)
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*))
99 (makunbound s)))
102 (defun read-data-file (&optional (file (open-file-dialog)))
103 "Args: (file)
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."
106 (if file
107 (let ((eof (gensym)))
108 (with-open-file (f file)
109 (if f
110 (do* ((r (read f nil eof) (read f nil eof))
111 (x (list nil))
112 (tail x (cdr tail)))
113 ((eq r eof) (cdr x))
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))
119 (cols (if file
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."
123 (if (and file cols)
124 (transpose (split-list (read-data-file file) cols))))
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)
159 :direction :output)
160 (let ((vars (if (consp vars) vars (list vars))))
161 (flet ((save-one (x)
162 (let ((v (symbol-value x)))
163 (if (objectp v)
164 (format f "(def ~s ~s)~%" x (send v :save))
165 (format f "(def ~s '~s)~%" x v)))))
166 (mapcar #'save-one vars))
167 vars)))