Update of /project/ganelon/cvsroot/ganelon/lisp In directory common-lisp.net:/tmp/cvs-serv20334/lisp

Modified Files: ganelon.asd html.lisp mvc.lisp utils.lisp Removed Files: compile.lisp Log Message:

Bugfixes + formatting

Date: Mon Mar 8 18:21:46 2004 Author: tlipski

Index: ganelon/lisp/ganelon.asd diff -u ganelon/lisp/ganelon.asd:1.1.1.1 ganelon/lisp/ganelon.asd:1.2 --- ganelon/lisp/ganelon.asd:1.1.1.1 Wed Mar 3 18:50:36 2004 +++ ganelon/lisp/ganelon.asd Mon Mar 8 18:21:46 2004 @@ -1,5 +1,17 @@ +; +; $Id: ganelon.asd,v 1.2 2004/03/08 23:21:46 tlipski Exp $ +; (asdf:defsystem "ganelon" :version "0.1" :components ((:file "utils") (:file "mvc" :depends-on ("utils")) (:file "html" :depends-on ("utils")))) + + +; +; $Log: ganelon.asd,v $ +; Revision 1.2 2004/03/08 23:21:46 tlipski +; +; Bugfixes + formatting +; +;

Index: ganelon/lisp/html.lisp diff -u ganelon/lisp/html.lisp:1.1.1.1 ganelon/lisp/html.lisp:1.2 --- ganelon/lisp/html.lisp:1.1.1.1 Wed Mar 3 18:50:35 2004 +++ ganelon/lisp/html.lisp Mon Mar 8 18:21:46 2004 @@ -1,24 +1,27 @@ ;;;; ;; package extending standard allegroserve html tags with support ;; for ganelon.mvc forms +; +; $Id: html.lisp,v 1.2 2004/03/08 23:21:46 tlipski Exp $ +; ;;;; (defpackage "GANELON.HTML" (:use - #:COMMON-LISP - #:NET.HTML.GENERATOR - #:GANELON.UTILS - ) + #:COMMON-LISP + #:NET.HTML.GENERATOR + #:GANELON.UTILS + ) (:export - #:mvc-bean - #:mvc-bean-value - #:mvc-form - #:mvc-input - #:mvc-select - #:mvc-option - #:mvc-radio - #:mvc-checkbox - #:mvc-textarea - ) + #:mvc-bean + #:mvc-bean-value + #:mvc-form + #:mvc-input + #:mvc-select + #:mvc-option + #:mvc-radio + #:mvc-checkbox + #:mvc-textarea + ) )

(in-package :GANELON.HTML) @@ -27,130 +30,127 @@ ;;form (defmacro mvc-form (name action params &rest body) "Generates and sets form (in variable named mvc-form, be careful!) - for use by other controls." + for use by other controls." `(let ((mvc-form (ganelon.mvc:get-form ,name - ganelon.mvc:req - ganelon.mvc:ent - ganelon.mvc:context - ganelon.mvc:session))) - (make-tag "form" - ,body - ,params - (cons "name" ,name) - (cons "action" (ganelon.mvc:get-action-url - ganelon.mvc:project ,action)))) + ganelon.mvc:context + ganelon.mvc:session))) + (make-tag "form" + ,body + ,params + (cons "name" ,name) + (cons "action" (ganelon.mvc:get-action-url + ganelon.mvc:project ,action)))) )

;;input with value -(defmacro mvc-input (name params - &key (value nil)) -"HTML input of default type text" +(defmacro mvc-input (name params &key (value nil)) + "HTML input of default type text" `(make-tag "input" - nil - ,params - (cons "name" ,name) - (cons "value" - (control-value ,name ,value))) + nil + ,params + (cons "name" ,name) + (cons "value" + (control-value ,name ,value))) )

(defmacro mvc-radio (name value &optional params) `(make-tag "input" - nil - ,params - (cons "name" ,name) - (cons "value" ,value) - (cons "type" "radio") - (if (equal ,value (control-value ,name nil)) - (cons "checked" "1"))) -) + nil + ,params + (cons "name" ,name) + (cons "value" ,value) + (cons "type" "radio") + (if (equal ,value (control-value ,name nil)) + (cons "checked" "1"))) + )

(defmacro mvc-checkbox (name value &optional params) `(make-tag "input" - nil - ,params - (cons "name" ,name) - (cons "value" ,value) - (cons "type" "checkbox") - (if (equal ,value (control-value ,name nil)) - (cons "checked" "1"))) + nil + ,params + (cons "name" ,name) + (cons "value" ,value) + (cons "type" "checkbox") + (if (equal ,value (control-value ,name nil)) + (cons "checked" "1"))) ) (defmacro mvc-select (name value params &rest body) `(let ((select-value (control-value ,name ,value))) - (make-tag "select" - ,body - ,params - (cons "name" ,name) - ) - ) -) + (make-tag "select" + ,body + ,params + (cons "name" ,name) + ) + ) + )

(defmacro mvc-option (value params &rest body) `(make-tag "option" - ,body - ,params - (cons "value" ,value) - (if (equal ,value select-value) - (cons "selected" "1"))) - + ,body + ,params + (cons "value" ,value) + (if (equal ,value select-value) + (cons "selected" "1"))) + )

(defmacro mvc-textarea (name &optional value params) `(make-tag "textarea" - '(net.html.generator:html - (:princ (control-value ,name ,value))) - ,params) -) - + '(net.html.generator:html + (:princ (control-value ,name ,value))) + ,params) + ) + (defmacro mvc-bean (property-path &optional context-type) `(mvc-bean-value - (case ,context-type - (:session (ganelon.mvc:session-fields ganelon.mvc:session)) - (:context ganelon.mvc:context) - (T (if (gethash (car ,property-path) - (ganelon.mvc:session-fields ganelon.mvc:session)) - (ganelon.mvc:session-fields ganelon.mvc:session) - ganelon.mvc:context))) - ,property-path - (ganelon.mvc::project-package ganelon.mvc:project)) -) + (case ,context-type + (:session (ganelon.mvc:session-fields ganelon.mvc:session)) + (:context ganelon.mvc:context) + (T (if (gethash (car ,property-path) + (ganelon.mvc:session-fields ganelon.mvc:session)) + (ganelon.mvc:session-fields ganelon.mvc:session) + ganelon.mvc:context))) + ,property-path + (ganelon.mvc::project-package ganelon.mvc:project)) + )

(defun mvc-bean-value (bean property-path package) ;;find a form or hashtable in session/request context (and bean (car property-path) - (get-property bean (car property-path) package) - (if (cdr property-path) - (mvc-bean-value (get-property - bean (car property-path) package) - (cdr property-path) - package) - (get-property bean (car property-path) package))) + (get-property bean (car property-path) package) + (if (cdr property-path) + (mvc-bean-value (get-property + bean (car property-path) package) + (cdr property-path) + package) + (get-property bean (car property-path) package))) )

(defun tag-params (params) (if params - (format nil "~A="~A" ~A" (caar params) (cdar params) - (tag-params (cdr params))) - "") + (format nil "~A="~A" ~A" (caar params) (cdar params) + (tag-params (cdr params))) + "") )

(defmacro make-tag (name body params &rest addparams) `(progn - (net.html.generator:html - (:princ - (format nil - "<~A ~A>" ,name - (tag-params - (nconc - (list ,@addparams) - ,params)) - ))) - ,@body - (net.html.generator:html - (:princ - (format nil "</~A>" ,name))) - ) + (net.html.generator:html + (:princ + (format nil + "<~A ~A>" ,name + (tag-params + (nconc + (list ,@addparams) + ,params)) + ))) + ,@body + (net.html.generator:html + (:princ + (format nil "</~A>" ,name))) + ) ) - + (defmacro control-value (name &optional value) `(if mvc-form (or ,value @@ -160,3 +160,11 @@ (or ,value "")) ) + +; +; $Log: html.lisp,v $ +; Revision 1.2 2004/03/08 23:21:46 tlipski +; +; Bugfixes + formatting +; +;

Index: ganelon/lisp/mvc.lisp diff -u ganelon/lisp/mvc.lisp:1.1.1.1 ganelon/lisp/mvc.lisp:1.2 --- ganelon/lisp/mvc.lisp:1.1.1.1 Wed Mar 3 18:50:35 2004 +++ ganelon/lisp/mvc.lisp Mon Mar 8 18:21:46 2004 @@ -1,46 +1,53 @@ ;;;; Mvc library for web apps under PAserve

+; +; $Id: mvc.lisp,v 1.2 2004/03/08 23:21:46 tlipski Exp $ +; (defpackage "GANELON.MVC" (:use #:COMMON-LISP - #:NET.ASERVE - #:GANELON.UTILS - ) + #:NET.ASERVE + #:GANELON.UTILS + ) (:export - #:action - #:page - #:form - #:init-project - #:add-project-entry - #:remove-project-entry - #:make-action - #:make-form - #:make-page - #:get-action-url - #:get-form - #:ent - #:context - #:session - #:project - #:req - #:session-fields - #:project-package - )) + #:action + #:page + #:form + #:init-project + #:add-project-entry + #:remove-project-entry + #:make-action + #:make-form + #:make-page + #:get-action-url + #:get-form + #:ent + #:context + #:session + #:project + #:req + #:session-fields + #:project-package + ))

(in-package :GANELON.MVC)

+(defvar *SESSSION-REAPER* nil) +(defvar *ALL-SESSIONS* (make-hash-table)) + (defstruct entry name path)

(defstruct (action - (:include entry)) + (:include entry)) function form-struct)

(defstruct (page - (:include entry)) - filepath) + (:include entry)) + filepath + charset)

(defstruct session fields @@ -50,7 +57,7 @@ name maker (scope :context)) ;; :context or :session - + (defstruct project name path @@ -59,324 +66,344 @@ page-functions sessions mappings - session-timeout) + session-timeout + path-prefix + lsp-default-charset)

;;;start a project -(defun init-project (name path entries package &key (session-timeout 30)) +(defun init-project (name path entries package &key (session-timeout 30) + (path-prefix "") (lsp-default-charset)) (let ((proj (make-project :name name :path path :entries nil - :page-functions (make-hash-table :test #'equal) - :sessions (make-hash-table :test #'equal) - :mappings (make-hash-table :test #'equal) - :package package - :session-timeout session-timeout))) - (dolist (entry entries) - (add-project-entry proj entry)) - (acl-compat.mp:process-run-function "Session reaper" - nil - 'session-reaper - (project-sessions proj)) - proj) - ) + :page-functions (make-hash-table :test #'equal) + :sessions (make-hash-table :test #'equal) + :mappings (make-hash-table :test #'equal) + :package package + :session-timeout session-timeout + :path-prefix path-prefix + :lsp-default-charset lsp-default-charset))) + (dolist (entry entries) + (add-project-entry proj entry)) + (add-sessions-to-rip (project-sessions proj) + name) + proj)) + +(defun add-sessions-to-rip (sessions project-name) + "Add project's sessions container to ripping process" + (if (null *SESSSION-REAPER*) + (start-reaper)) + (setf (gethash project-name *ALL-SESSIONS*) + sessions)) + +(defun start-reaper () + "Start the session reaper process" + (acl-compat.mp:process-run-function "Session reaper" 'session-reaper) + (setq *SESSSION-REAPER* T))

;;add new entry to project (defun add-project-entry (proj entry) + (if (page-p entry) + (setf (page-filepath entry) + (concatenate 'string (project-path-prefix proj) + (page-filepath entry)))) (setf (project-entries proj) - (cons entry (project-entries proj))) - (setf (gethash (entry-name entry) (project-mappings proj)) - entry) - (publish - :path (concatenate 'string - (project-path proj) - "/" - (entry-path entry)) - :function - #'(lambda (req ent) - (route-entry - req - ent - (make-hash-table :test #'equal) - proj - (entry-name entry) - (get-session req proj)))) - ) + (cons entry (project-entries proj))) + (setf (gethash (entry-name entry) (project-mappings proj)) + entry) + (publish + :path (concatenate 'string (project-path proj) "/" (entry-path entry)) + :function #'(lambda (req ent) + (route-entry req ent (make-hash-table :test #'equal) proj + (entry-name entry) + (get-session req proj)))))

(defun remove-project-entry (project name) (setf (project-entries project) - (remove-if #'(lambda(x) - (eq (entry-name x) name)) - (project-entries project))) -) + (remove-if #'(lambda(x) + (eq (entry-name x) name)) + (project-entries project))) + )

;;;route entries (defun route-entry (req ent context project name session) (let ((entry (gethash name (project-mappings project)))) - (if (not entry) - (maphash #'(lambda (k v) - (format t "~A: ~A~%" k v)) - (project-mappings project))) - (if (action-p entry) - (serve-action req ent context project entry session)) - (if (page-p entry) - (serve-page req ent context project entry session))) + (if (not entry) + (maphash #'(lambda (k v) + (format t "~A: ~A~%" k v)) + (project-mappings project))) + (if (action-p entry) + (serve-action req ent context project entry session)) + (if (page-p entry) + (serve-page req ent context project entry session))) )

;;;serve action, routing the chain to another action or page (defun serve-action (req ent context project action session) (route-entry req ent context project - (funcall (action-function action) - req - ent - context - session - (get-action-form - action - context - session - project - req)) - session) + (funcall (action-function action) + req + ent + context + session + (get-action-form + action + context + session + project + req)) + session) )

;;;serve page, returning the output to client (defun serve-page (req ent context project page session) (with-http-response (req ent) - (setf (reply-header-slot-value req :CONTENT-TYPE) - "text/html; charset=iso-8859-2") - (let ((page-func (gethash (page-filepath page) - (project-page-functions project)))) - (funcall (car - (if (and page-func - (> (cdr page-func) (or (file-write-date - (page-filepath page)) 0))) - page-func - (setf (gethash (page-filepath page) - (project-page-functions project)) - (cons (page-function-from-file (page-filepath page) - (project-package project)) - (get-universal-time))))) - req ent context session project) - ) - ) + (if (or (page-charset page) + (project-lsp-default-charset project)) + (setf (reply-header-slot-value req :CONTENT-TYPE) + (concatenate 'string + "text/html; charset=" + (or (page-charset page) + (project-lsp-default-charset + project))))) + (let ((page-func (gethash (page-filepath page) + (project-page-functions project)))) + (funcall (car + (if (and page-func + (> (cdr page-func) + (or (file-write-date (page-filepath page)) 0))) + page-func + (setf (gethash (page-filepath page) + (project-page-functions project)) + (cons (page-function-from-file (page-filepath page) + (project-package project)) + (get-universal-time))))) + req ent context session project) + ) + ) )

(defun page-function-from-file (filename package) - (format t "page-function-from-file ~A ~%" filename) - (format t "package ~A~%" *package*) (in-package (symb package)) - (format t "package ~A~%" *package*) - (format t - "(progn ~A)~%" - (construct-page-func-string - (contents-of-file filename))) (compile nil - `(lambda (req ent context session project) - (net.aserve:with-http-body (req ent) - ,(read-from-string - (format nil - "(progn ~A)" - (construct-page-func-string - (contents-of-file filename))))))) + `(lambda (req ent context session project) + (net.aserve:with-http-body (req ent) + ,(read-from-string + (format nil + "(progn ~A)" + (construct-page-func-string + (contents-of-file filename))))))) )

(defun construct-page-func-string (str &optional (start 0)) "Text up until <% tag is translated into (net.html.generator:html 'text') - Text inside <% %> is translated to code or expanded as a directive" - + Text inside <% %> is translated to code or expanded as a directive" + (multiple-value-bind (tagpos scriptpos endpos type) - (find-script str start) - (if (not tagpos) ;;No scriplets, simply format to html macro - (format nil "(net.html.generator:html ~S)" - (subseq str start)) - ;;found a scriplet, decide on type - (format nil (if (> tagpos start) - "(net.html.generator:html ~S) ~A ~A" - "~A ~A") - (subseq str start tagpos) - (tag-expand type (subseq str scriptpos endpos)) - (construct-page-func-string str (+ endpos 2))))) -) + (find-script str start) + (if (not tagpos) ;;No scriplets, simply format to html macro + (format nil "(net.html.generator:html ~S)" + (subseq str start)) + ;;found a scriplet, decide on type + (format nil (if (> tagpos start) + "(net.html.generator:html ~S) ~A ~A" + "~A ~A") + (subseq str start tagpos) + (tag-expand type (subseq str scriptpos endpos)) + (construct-page-func-string str (+ endpos 2))))) + )

(defun tag-expand (type body) (case type - (:script (format nil "~A" body)) - (:expr (format nil "(net.html.generator:html (:princ ~A))" body)) - (:directive (expand-directive body))) + (:script (format nil "~A" body)) + (:expr (format nil "(net.html.generator:html (:princ ~A))" body)) + (:directive (expand-directive body))) )

(defun expand-directive (body) (format t "expand-directive~%") (format t "~A~%" (construct-page-func-string - (funcall (compile nil `(lambda () - ,(read-from-string - (format nil "(progn ~A)~%" body))))))) + (funcall (compile nil `(lambda () + ,(read-from-string + (format nil "(progn ~A)~%" body))))))) (construct-page-func-string - (funcall - (compile nil `(lambda () - ,(read-from-string - (format nil "(progn ~A)~%" body)))))) + (funcall + (compile nil `(lambda () + ,(read-from-string + (format nil "(progn ~A)~%" body)))))) )

(defun find-script (str start) (let ((startpos (search "<%" str :start2 start))) - (if startpos - (let ((endpos (search "%>" str :start2 (+ start 2)))) - (if endpos - (case (char str (+ startpos 2)) - (#= - (values startpos (+ startpos 3) - endpos :expr)) - (#@ - (values startpos (+ startpos 3) - endpos :directive)) - (t - (values startpos (+ startpos 2) - endpos :script))) - (error "EOF inside open '<%'.") - ) - ) - (values nil nil nil nil))) + (if startpos + (let ((endpos (search "%>" str :start2 (+ start 2)))) + (if endpos + (case (char str (+ startpos 2)) + (#= + (values startpos (+ startpos 3) + endpos :expr)) + (#@ + (values startpos (+ startpos 3) + endpos :directive)) + (t + (values startpos (+ startpos 2) + endpos :script))) + (error "EOF inside open '<%'.") + ) + ) + (values nil nil nil nil))) )

;;;get session from request and session-container ;;;if session does not exist, it creates one (side-effect) (defun get-session (req project) (let* ((session-container (project-sessions project)) - (sessid - (cdr (find-if #'(lambda(x) - (if (equal (format nil "~A" (car x)) "SESSID") - x )) - (get-cookie-values req))))) - (if (not sessid) - (setq sessid (make-sessid session-container))) - (let ((sess (gethash sessid session-container))) - (if sess - (if (<= (get-universal-time) (session-expires sess)) - (setf (session-expires sess) - (+ (get-universal-time) - (* 60 (project-session-timeout project)))) - (progn - (setq sessid (make-sessid session-container)) - (setq sess nil)))) - - (if (not sess) - (progn - (setq sess (make-session - :fields (make-hash-table :test #'equal) - :expires (+ (get-universal-time) - (* 60 (project-session-timeout project))))) - (setf (gethash sessid session-container) sess))) - (set-cookie-header req - :name "SESSID" - :value sessid) - sess)) - ) - -(defun session-reaper (session-container) - (let ((curr-time (get-universal-time))) - (maphash #'(lambda (sessid sess) - (if (> curr-time (session-expires sess)) - (remhash sessid (session-container)))) - session-container)) + (sessid + (cdr (find-if #'(lambda(x) + (if (equal (format nil "~A" (car x)) "SESSID") + x )) + (get-cookie-values req))))) + (if (not sessid) + (setq sessid (make-sessid session-container))) + (let ((sess (gethash sessid session-container))) + (if sess + (if (<= (get-universal-time) (session-expires sess)) + (setf (session-expires sess) + (+ (get-universal-time) + (* 60 (project-session-timeout project)))) + (progn + (setq sessid (make-sessid session-container)) + (setq sess nil)))) + + (if (not sess) + (progn + (setq sess (make-session + :fields (make-hash-table :test #'equal) + :expires (+ (get-universal-time) + (* 60 (project-session-timeout project))))) + (setf (gethash sessid session-container) sess))) + (set-cookie-header req + :name "SESSID" + :value sessid) + sess)) + ) + +(defun session-reaper () + (maphash #'(lambda (k v) + (sessions-reap v)) + *ALL-SESSIONS*) (sleep 30) + (session-reaper))

- (sesseion-reaper project) - ) +(defun sessions-reap (session-container) + (let ((curr-time (get-universal-time))) + (maphash #'(lambda (sessid sess) + (if (> curr-time (session-expires sess)) + (remhash sessid session-container))) + session-container)))

;;;create unique session id (defun make-sessid (session-container) (format t "make-sessid~%") (let ((sessid (format nil "~X" (random 999999999)))) - (if (gethash sessid session-container) - (make-sessid session-container) - sessid) - ) -) + (if (gethash sessid session-container) + (make-sessid session-container) + sessid) + ) + )

;;;fill structure from query data (defun make-form-struct (query form project) (format t "make-form-struct") (let ((struct (funcall (form-maker form)))) - (format t "made-form-struct") - (update-form-struct query struct project) + (format t "made-form-struct") + (update-form-struct query struct project) + ) ) -)

(defun update-form-struct (query struct project) (format t "update-form-struct ~%") (let ((pack (project-package project))) - - (dolist (param query) - (format t "~A: ~A~%" (car param) (cdr param)) - (if (slot-exists-p struct (symb2 pack (car param))) - (setf (slot-value struct (symb2 pack (car param))) (cdr param)) - (format t "Nie ma slotu ~A ~A~%" (car param) struct))) - struct - ) + + (dolist (param query) + (format t "~A: ~A~%" (car param) (cdr param)) + (if (slot-exists-p struct (symb2 pack (car param))) + (setf (slot-value struct (symb2 pack (car param))) (cdr param)) + (format t "Nie ma slotu ~A ~A~%" (car param) struct))) + struct + ) ) + +(defmacro sess-value (session name) + `(gethash ,name (session-fields ,session)) + ) + ;;;read form from request, context, session (defun fetch-form (form cont sess req project) (format t "fetch-form ~%") (let* ((form-name (form-name form)) - (sess-form (sess-value sess form-name)) - (cont-form (gethash form-name cont))) - (format t "~A ~A ~A ~%" form-name sess-form cont-form) - (if cont-form - cont-form - (setf (gethash form-name cont) - (if sess-form - (update-form-struct (request-query req) - sess-form - project) - (make-form-struct (request-query req) - form - project)))) - ) + (sess-form (sess-value sess form-name)) + (cont-form (gethash form-name cont))) + (format t "~A ~A ~A ~%" form-name sess-form cont-form) + (if cont-form + cont-form + (setf (gethash form-name cont) + (if sess-form + (update-form-struct (request-query req) + sess-form + project) + (make-form-struct (request-query req) + form + project)))) + ) )

+ ;;;update session forms (defun update-session-form (form form-data session) (format t "update-session-form ~A ~%" (form-scope form)) (if (equal (form-scope form) :session) - (setf (sess-value session (form-name form)) - form-data)) + (setf (sess-value session (form-name form)) + form-data)) form-data - ) + )

(defun get-action-form (action cont sess project req) (format t "get-action-form ~%") (if (action-form-struct action) - (update-session-form (action-form-struct action) - (fetch-form (action-form-struct action) - cont - sess - req - project - ) - sess) - nil - ) -) + (update-session-form (action-form-struct action) + (fetch-form (action-form-struct action) + cont + sess + req + project + ) + sess) + nil + ) + )

(defun get-action-url (project action-name) (let ((action (gethash action-name (project-mappings project)))) - (if action - (strconc (project-path project) "/" (action-path action)) - (strconc "#No action named: '" action-name "'!!!") - )) -) + (if action + (strconc (project-path project) "/" (action-path action)) + (strconc "#No action named: '" action-name "'!!!") + )) + )

;;get form by name -(defun get-form (form-name req ent cont session) +(defun get-form (form-name cont session) (let ((form (gethash form-name cont))) - (if form - form - (sess-value session form-name))) + (if form form + (sess-value session form-name))) )

-(defmacro sess-value (session name) - `(gethash ,name (session-fields ,session)) - ) +; +; $Log: mvc.lisp,v $ +; Revision 1.2 2004/03/08 23:21:46 tlipski +; +; Bugfixes + formatting +; +;

Index: ganelon/lisp/utils.lisp diff -u ganelon/lisp/utils.lisp:1.1.1.1 ganelon/lisp/utils.lisp:1.2 --- ganelon/lisp/utils.lisp:1.1.1.1 Wed Mar 3 18:50:36 2004 +++ ganelon/lisp/utils.lisp Mon Mar 8 18:21:46 2004 @@ -1,3 +1,7 @@ +; +; $Id: utils.lisp,v 1.2 2004/03/08 23:21:46 tlipski Exp $ +; + (defpackage "GANELON.UTILS" (:export #:get-struct-value @@ -24,15 +28,14 @@ ) (in-package :GANELON.UTILS)

-(defun get-struct-value (form name) - (slot-value form (symb name)) - ) - ;;;translate string into symbol (defmacro symb (&rest args) `(values (intern (string-upcase (concatenate 'string ,@args)))) ) +(defun get-struct-value (form name) + (slot-value form (symb name)) + )

(defmacro symb2 (package &rest args) `(values (intern (string-upcase @@ -199,3 +202,11 @@ (setf (nth idx list) (funcall fun (nth idx list))) ) + +; +; $Log: utils.lisp,v $ +; Revision 1.2 2004/03/08 23:21:46 tlipski +; +; Bugfixes + formatting +; +;