src/data/data-xls-compat.lisp

   1 ;;; -*- mode: lisp -*-
   2
   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
  11
  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.
  15
  16 ;;; This organization and structure is new to the 21st Century
  17 ;;; version..   Think, "21st Century Schizoid Man".
  18
  19 (in-package :lisp-stat-data)
  20
  21 ;; XLISPSTAT compatibility functions.
  22
  23 ;;;
  24 ;;; Listing and Saving Variables and Functions (XLispStat compatibility)
  25 ;;;
  26
  27 (defvar *variables* nil)
  28 (defvar *ask-on-redefine* nil)
  29
  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))
  45
  46
  47 ;; (def *mydef* (list 1 2 3 4 5))
  48
  49 #| Taken from the CLHS, for use in getting the DEF XLS-compat function right.
  50 defparameter and defvar might be defined as follows:
  51
  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))
  69 |#
  70
  71 (defun variables-list ()
  72   "Return list of variables as a lisp list of strings."
  73   (mapcar #'intern (sort-data (mapcar #'string *variables*))))
  74
  75 (defun variables ()
  76   "Args:()
  77 Returns a list of the names of all def'ed variables to STREAM.
  78
  79 FIXME: THIS IS BROKEN -- NEEDS TO ALSO PROVIDE PACKAGE LOCATION AS WELL!!"
  80   (if *variables*
  81       (mapcar #'intern (sort-data (mapcar #'string *variables*)))))
  82
  83
  84 #|
  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.
  91 |#
  92
  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)))
 102   v)
 103
 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))))))))
 117
 118 ;;; New definition to avoid stack size limit in apply
 119 #|
 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))))
 127 |#
 128
 129 ;;; FIXME:AJR: ALL THE FOLLOWING NEED TO BE SOLVED BY PLATFORM-INDEP PATHNAME WORK!
 130 ;;; FIXME:AJR: use either string or pathname.
 131
 132 (defun path-string-to-path (p s)
 133     (pathname (concatenate 'string (namestring p) s)))
 134
 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)
 139       t
 140       (load (path-string-to-path *cls-data-dir* file) :verbose T :print T)))
 141
 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))
 146       t
 147       (load (path-string-to-path cls-config:*cls-examples-dir* file))))
 148
 149 ;;;
 150 ;;; Saving Variables and Functions
 151 ;;;
 152
 153 (defun savevar (vars file &optional (suffix ".lsp"))
 154   "Args: (vars-symbol-or-list file-name-root &optional suffix-string)
 155
 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)))