src/data/data-xls-compat.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2009-12-23 14:18:47 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 (symbol value)
  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
  37      (unless (and *ask-on-redefine*
  38                   (boundp ',symbol)
  39                   (not (y-or-n-p "Variable has a value. Redefine?")))
  40        (defparameter ,symbol ,value))
  41      (pushnew ',symbol *variables*)
  42      ',symbol))
  43
  44 (defun variables-list ()
  45   "Return list of variables as a lisp list of strings."
  46   (mapcar #'intern (sort-data (mapcar #'string *variables*))))
  47
  48 (defun variables ()
  49   "Args:()
  50 Returns a list of the names of all def'ed variables to STREAM"
  51   (if *variables*
  52       (mapcar #'intern (sort-data (mapcar #'string *variables*)))))
  53
  54
  55 (defun undef (v)
  56 "Args: (v)
  57 If V is the symbol of a defined variable the variable it is unbound and
  58 removed from the list of defined variables. If V is a list of variable
  59 names each is unbound and removed. Returns V."
  60   (dolist (s (if (listp v) v (list v)))
  61           (when (member s *variables*)
  62                 (setq *variables* (delete s *variables*))
  63                 (makunbound s)))
  64   v)
  65
  66 (defun read-data-file (&optional (file (open-file-dialog)))
  67 "Args:  (file)
  68 Returns a list of all lisp objects in FILE. FILE can be a string or a symbol,
  69 in which case the symbol'f print name is used."
  70   (if file
  71       (let ((eof (gensym)))
  72         (with-open-file (f file)
  73           (if f
  74               (do* ((r (read f nil eof) (read f nil eof))
  75                     (x (list nil))
  76                     (tail x (cdr tail)))
  77                    ((eq r eof) (cdr x))
  78                    (setf (cdr tail) (list r))))))))
  79
  80 ;;; New definition to avoid stack size limit in apply
  81 #|
  82  (defun read-data-columns (&optional (file (open-file-dialog))
  83                                     (cols (if file
  84                                               (count-file-columns file))))
  85 "Args: (&optional file cols)
  86 Reads the data in FILE as COLS columns and returns a list of lists representing the columns."
  87   (if (and file cols)
  88       (transpose (split-list (read-data-file file) cols))))
  89 |#
  90
  91 ;;; FIXME:AJR:  ALL THE FOLLOWING NEED TO BE SOLVED BY PLATFORM-INDEP PATHNAME WORK!
  92 ;;; FIXME:AJR: use either string or pathname.
  93
  94 (defun path-string-to-path (p s)
  95     (pathname (concatenate 'string (namestring p) s)))
  96
  97 (defun load-data (file)
  98 "Args: (file) as string
  99 Read in data file from the System DATA library."
 100   (if (load (path-string-to-path *cls-data-dir* file))
 101       t
 102       (load (path-string-to-path *cls-data-dir* file))))
 103
 104 (defun load-example (file)
 105   "Args: (file) as string
 106 Read in lisp example file from the System EXAMPLES library."
 107   (if (load (path-string-to-path cls-config:*cls-examples-dir* file))
 108       t
 109       (load (path-string-to-path cls-config:*cls-examples-dir* file))))
 110
 111 ;;;
 112 ;;; Saving Variables and Functions
 113 ;;;
 114
 115 (defun savevar (vars file &optional (suffix ".lsp"))
 116   "Args: (vars-symbol-or-list file-name-root &optional suffix-string)
 117
 118 VARS is a symbol or a list of symbols. FILE-NAME-ROOT is a string (or
 119 a symbol whose print name is used) not ending in SUFFIX (defaults to
 120 \".lsp\"). The VARS and their current values are written to the file
 121 FILE-NAME-ROOT.lsp in a form suitable for use with the load command."
 122   (with-open-file (f (concatenate 'string (namestring file) suffix)
 123                      :direction :output)
 124     (let ((vars (if (consp vars) vars (list vars))))
 125       (flet ((save-one (x)
 126                (let ((v (symbol-value x)))
 127                  (if (objectp v)
 128                      (format f "(def ~s ~s)~%" x (send v :save))
 129                    (format f "(def ~s '~s)~%" x v)))))
 130             (mapcar #'save-one vars))
 131       vars)))