Loading base/rest/source/vanilla-mixin.lisp +5 −3 Original line number Diff line number Diff line Loading @@ -948,8 +948,7 @@ by the update." (&key (replace-bashed-values? t) immune-message-keys) (let ((all-messages (the (:message-list))) (methods (the (:message-list :category :functions))) (immune-messages (append (list :$$ta2 :$$ta2-object :$$tatu :$$tatu-object) (immune-messages (append (list :object-unique-id) (ensure-list immune-message-keys))) (true-root (if (and (the root parent) (the root parent root?) (defaulting (the root parent root-object-object)) Loading Loading @@ -1256,7 +1255,10 @@ object as a toplevel input at the time of object instantiation.</li></ol>" (defmethod print-object ((object vanilla-mixin) stream) (print-unreadable-object (object stream :type t) (format stream "~a" (theo object object-unique-id)))) (format stream "~a (~a)" (theo object object-unique-id) (with-output-to-string(ss)(call-next-method object ss))))) (define-object vanilla-mixin (vanilla-mixin* gdl-basis) Loading gwl/source/answer.lisp +40 −17 Original line number Diff line number Diff line Loading @@ -398,6 +398,7 @@ package-qualified object name\") (server *http-server*) host ;; by default this comes from object. hosts overwrite? (key (make-keyword-sensitive (format nil "~a~a" (if host (format nil "~a/" host) "") (first paths)))) object ;; if you want to provide an already-instantiated one. Will override object-type. Loading Loading @@ -431,27 +432,46 @@ being generated dynamically. </pre>" (assert (consp paths)) (assert (every #'(lambda(path) (and (stringp path) (plusp (length path)) (eql (aref path 0) #\/))) paths)) (assert (every #'(lambda(path) (and (stringp path) (plusp (length path)) (eql (aref path 0) #\/))) paths)) (let ((self (or object (apply #'make-object (if (stringp object-type) (let* ((requested-type (if (stringp object-type) (read-safe-string object-type) object-type) object-type)) (existing nil) (self (or object (unless overwrite? (setq existing (first (gethash key *instance-hash-table*))) (when (and existing (typep existing requested-type)) existing)) (apply #'make-object requested-type :compute-urls paths :instance-id key :plain-url? t :pre-published? t :host host object-args)))) (if existing (format t "Found existing ~s, and :overwrite was not specified to publish-shared. Not replacing existing instance in `gwl:*instance-hash-table*`~%" requested-type) (progn (setf (gethash key *instance-hash-table*) (list self)) (format t "Just set ~s into the instance hash table." self))) (let ((hosts (or (ensure-list (or hosts host (the host))) (list nil))) (function #'(lambda(req ent) (the (before-response!)) (the (present-part req ent))))) (the (present-part req ent)) ))) (dolist (path paths) (pushnew path (gethash (make-keyword (the instance-id)) *url-hash-table*) :test #'string-equal) (pushnew path (gethash (make-keyword (the instance-id)) *url-hash-table*) :test #'string-equal) (when *debug?* (print-variables path server host (or content-type (the content-type)) function aserve-args)) (when *debug?* (print-variables path server host (or content-type (the content-type)) function aserve-args)) (dolist (host hosts) (apply #'publish :path path Loading Loading @@ -483,7 +503,8 @@ being generated dynamically. (string-equal (second (getf (the query-plist) key)) "true")) (list (make-keyword-sensitive (glisp:replace-regexp (glisp:replace-regexp (glisp:replace-regexp (format nil "~a" key) "^RADIO-" "") (glisp:replace-regexp (format nil "~a" key) "^RADIO-" "") "^radio-" "") "-.*" "")) (first (getf (the query-plist) key))))) Loading @@ -492,8 +513,10 @@ being generated dynamically. (query-plist-all (append (the radios) (mapcan #'(lambda(key val) (unless (or (glisp:match-regexp "^radio-" (string-downcase (format nil "~a" key))) (glisp:match-regexp "-checkedp$" (string-downcase (format nil "~a" key)))) (unless (or (glisp:match-regexp "^radio-" (string-downcase (format nil "~a" key))) (glisp:match-regexp "-checkedp$" (string-downcase (format nil "~a" key)))) (list key val))) (plist-keys (the query-plist)) (plist-values (the query-plist))))) Loading gwl/source/base-html-sheet.lisp +4 −2 Original line number Diff line number Diff line Loading @@ -329,13 +329,15 @@ values are set into the specified bashee." (let* ((skin (third (gethash (the instance-id) *instance-hash-table*))) (respondent self)) (when *debug?* (print-variables (the instance-id) (the root) (the root-path) respondent)) (when *debug?* (print-variables (the instance-id) (the root) (the root-path) respondent)) ;; ;; FLAG -- use actual application-root rather than global root here ;; (when (and respondent (the-object respondent root) (typep (the-object respondent root) 'session-control-mixin)) (typep (the-object respondent root) 'session-control-mixin)) (the-object respondent root (set-expires-at))) (when (and respondent (the-object respondent root) (the-object respondent root (set-time-last-touched!)))) Loading Loading
base/rest/source/vanilla-mixin.lisp +5 −3 Original line number Diff line number Diff line Loading @@ -948,8 +948,7 @@ by the update." (&key (replace-bashed-values? t) immune-message-keys) (let ((all-messages (the (:message-list))) (methods (the (:message-list :category :functions))) (immune-messages (append (list :$$ta2 :$$ta2-object :$$tatu :$$tatu-object) (immune-messages (append (list :object-unique-id) (ensure-list immune-message-keys))) (true-root (if (and (the root parent) (the root parent root?) (defaulting (the root parent root-object-object)) Loading Loading @@ -1256,7 +1255,10 @@ object as a toplevel input at the time of object instantiation.</li></ol>" (defmethod print-object ((object vanilla-mixin) stream) (print-unreadable-object (object stream :type t) (format stream "~a" (theo object object-unique-id)))) (format stream "~a (~a)" (theo object object-unique-id) (with-output-to-string(ss)(call-next-method object ss))))) (define-object vanilla-mixin (vanilla-mixin* gdl-basis) Loading
gwl/source/answer.lisp +40 −17 Original line number Diff line number Diff line Loading @@ -398,6 +398,7 @@ package-qualified object name\") (server *http-server*) host ;; by default this comes from object. hosts overwrite? (key (make-keyword-sensitive (format nil "~a~a" (if host (format nil "~a/" host) "") (first paths)))) object ;; if you want to provide an already-instantiated one. Will override object-type. Loading Loading @@ -431,27 +432,46 @@ being generated dynamically. </pre>" (assert (consp paths)) (assert (every #'(lambda(path) (and (stringp path) (plusp (length path)) (eql (aref path 0) #\/))) paths)) (assert (every #'(lambda(path) (and (stringp path) (plusp (length path)) (eql (aref path 0) #\/))) paths)) (let ((self (or object (apply #'make-object (if (stringp object-type) (let* ((requested-type (if (stringp object-type) (read-safe-string object-type) object-type) object-type)) (existing nil) (self (or object (unless overwrite? (setq existing (first (gethash key *instance-hash-table*))) (when (and existing (typep existing requested-type)) existing)) (apply #'make-object requested-type :compute-urls paths :instance-id key :plain-url? t :pre-published? t :host host object-args)))) (if existing (format t "Found existing ~s, and :overwrite was not specified to publish-shared. Not replacing existing instance in `gwl:*instance-hash-table*`~%" requested-type) (progn (setf (gethash key *instance-hash-table*) (list self)) (format t "Just set ~s into the instance hash table." self))) (let ((hosts (or (ensure-list (or hosts host (the host))) (list nil))) (function #'(lambda(req ent) (the (before-response!)) (the (present-part req ent))))) (the (present-part req ent)) ))) (dolist (path paths) (pushnew path (gethash (make-keyword (the instance-id)) *url-hash-table*) :test #'string-equal) (pushnew path (gethash (make-keyword (the instance-id)) *url-hash-table*) :test #'string-equal) (when *debug?* (print-variables path server host (or content-type (the content-type)) function aserve-args)) (when *debug?* (print-variables path server host (or content-type (the content-type)) function aserve-args)) (dolist (host hosts) (apply #'publish :path path Loading Loading @@ -483,7 +503,8 @@ being generated dynamically. (string-equal (second (getf (the query-plist) key)) "true")) (list (make-keyword-sensitive (glisp:replace-regexp (glisp:replace-regexp (glisp:replace-regexp (format nil "~a" key) "^RADIO-" "") (glisp:replace-regexp (format nil "~a" key) "^RADIO-" "") "^radio-" "") "-.*" "")) (first (getf (the query-plist) key))))) Loading @@ -492,8 +513,10 @@ being generated dynamically. (query-plist-all (append (the radios) (mapcan #'(lambda(key val) (unless (or (glisp:match-regexp "^radio-" (string-downcase (format nil "~a" key))) (glisp:match-regexp "-checkedp$" (string-downcase (format nil "~a" key)))) (unless (or (glisp:match-regexp "^radio-" (string-downcase (format nil "~a" key))) (glisp:match-regexp "-checkedp$" (string-downcase (format nil "~a" key)))) (list key val))) (plist-keys (the query-plist)) (plist-values (the query-plist))))) Loading
gwl/source/base-html-sheet.lisp +4 −2 Original line number Diff line number Diff line Loading @@ -329,13 +329,15 @@ values are set into the specified bashee." (let* ((skin (third (gethash (the instance-id) *instance-hash-table*))) (respondent self)) (when *debug?* (print-variables (the instance-id) (the root) (the root-path) respondent)) (when *debug?* (print-variables (the instance-id) (the root) (the root-path) respondent)) ;; ;; FLAG -- use actual application-root rather than global root here ;; (when (and respondent (the-object respondent root) (typep (the-object respondent root) 'session-control-mixin)) (typep (the-object respondent root) 'session-control-mixin)) (the-object respondent root (set-expires-at))) (when (and respondent (the-object respondent root) (the-object respondent root (set-time-last-touched!)))) Loading