Commit 423cd1a2 authored by Dave Cooper's avatar Dave Cooper

Fix casemode in dgdl so GLM will work with both gdl and agdl.

parent b18d6181
...@@ -43,6 +43,7 @@ ...@@ -43,6 +43,7 @@
(defparameter *remote-syntax* nil) (defparameter *remote-syntax* nil)
(defun remote-function-handler (handler &key (encode t)) ;;&optional lock (defun remote-function-handler (handler &key (encode t)) ;;&optional lock
#'(lambda (req ent) #'(lambda (req ent)
(progn ;; bt:with-lock-held (lock) (progn ;; bt:with-lock-held (lock)
...@@ -54,6 +55,8 @@ ...@@ -54,6 +55,8 @@
(syntax-string (rest (assoc "syntax" query :test #'string-equal))) (syntax-string (rest (assoc "syntax" query :test #'string-equal)))
(*remote-syntax* (if syntax-string (read-safe-string syntax-string) :json)) (*remote-syntax* (if syntax-string (read-safe-string syntax-string) :json))
(args-list (decode-plist-from-url *remote-syntax* args))) (args-list (decode-plist-from-url *remote-syntax* args)))
(when (eql excl:*current-case-mode* :case-sensitive-lower)
(setq args-list (downcase-plist args-list)))
(glisp:with-heuristic-case-mode () (glisp:with-heuristic-case-mode ()
(with-http-response (req ent) (with-http-response (req ent)
(with-http-body (req ent) (with-http-body (req ent)
...@@ -299,6 +302,7 @@ ...@@ -299,6 +302,7 @@
(format t "~%In send-remote-message-object response func:~%") (format t "~%In send-remote-message-object response func:~%")
(print-variables args-list *ipaddr* *request-server-ipaddr*)) (print-variables args-list *ipaddr* *request-server-ipaddr*))
(let ((*package* (or (find-package (getf args-list :package)) *package*))) (let ((*package* (or (find-package (getf args-list :package)) *package*)))
(let ((object (when (gethash (getf args-list :remote-id) *remote-objects-hash*) (let ((object (when (gethash (getf args-list :remote-id) *remote-objects-hash*)
(the-object (gethash (getf args-list :remote-id) *remote-objects-hash*) (the-object (gethash (getf args-list :remote-id) *remote-objects-hash*)
...@@ -307,6 +311,8 @@ ...@@ -307,6 +311,8 @@
(gdl::*notify-cons* (decode-from-http (getf args-list :notify-cons))) (gdl::*notify-cons* (decode-from-http (getf args-list :notify-cons)))
(args (getf args-list :args))) (args (getf args-list :args)))
(when *debug?* (print-variables args))
(if object (multiple-value-bind (value error) (if object (multiple-value-bind (value error)
(progn ;; bt:with-lock-held (*remote-evaluate-lock*) (progn ;; bt:with-lock-held (*remote-evaluate-lock*)
(ignore-errors (if args (ignore-errors (if args
......
...@@ -35,19 +35,27 @@ ...@@ -35,19 +35,27 @@
(defun upcase-plist (plist) (defun upcase-plist (plist)
(mapcan #'(lambda(key value) (change-plist-case plist :up))
(list (make-keyword (string-upcase key))
(cond ((keywordp value) (make-keyword (string-upcase value))) (defun downcase-plist (plist)
((symbolp value) (change-plist-case plist :down))
(cond ((null value) nil)
(t (string-upcase (defun change-plist-case (plist up-or-down)
(string (let ((function (ecase up-or-down (:up #'string-upcase) (:down #'string-downcase))))
(intern (string value) (mapcan #'(lambda(key value)
(symbol-package value))))))) (list (make-keyword (funcall function key))
((consp value) (upcase-plist value)) (cond ((keywordp value) (make-keyword
((stringp value) value) (funcall function value)))
(t value)))) ((symbolp value)
(plist-keys plist) (plist-values plist))) (cond ((null value) nil)
(t (funcall function
(string
(intern (string value)
(symbol-package value)))))))
((consp value) (change-plist-case value up-or-down))
((stringp value) value)
(t value))))
(plist-keys plist) (plist-values plist))))
(defmethod encode-plist-for-url ((syntax (eql :json)) plist) (defmethod encode-plist-for-url ((syntax (eql :json)) plist)
......
gwl/static/gwl/images/favicon.ico

4.58 KB | W: | H:

gwl/static/gwl/images/favicon.ico

7.23 KB | W: | H:

gwl/static/gwl/images/favicon.ico
gwl/static/gwl/images/favicon.ico
gwl/static/gwl/images/favicon.ico
gwl/static/gwl/images/favicon.ico
  • 2-up
  • Swipe
  • Onion skin
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment