src/data/data-xls-compat.lisp

   1 ;;; -*- mode: lisp -*-
   2
   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
   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   (if *variables*
  79       (mapcar #'intern (sort-data (mapcar #'string *variables*)))))
  80
  81
  82 #|
  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.
  89 |#
  90
  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)))
 100   v)
 101
 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))))))))
 115
 116 ;;; New definition to avoid stack size limit in apply
 117 #|
 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))))
 125 |#
 126
 127 ;;; FIXME:AJR:  ALL THE FOLLOWING NEED TO BE SOLVED BY PLATFORM-INDEP PATHNAME WORK!
 128 ;;; FIXME:AJR: use either string or pathname.
 129
 130 (defun path-string-to-path (p s)
 131     (pathname (concatenate 'string (namestring p) s)))
 132
 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))
 137       t
 138       (load (path-string-to-path *cls-data-dir* file))))
 139
 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))
 144       t
 145       (load (path-string-to-path cls-config:*cls-examples-dir* file))))
 146
 147 ;;;
 148 ;;; Saving Variables and Functions
 149 ;;;
 150
 151 (defun savevar (vars file &optional (suffix ".lsp"))
 152   "Args: (vars-symbol-or-list file-name-root &optional suffix-string)
 153
 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)))