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

4.58 KB | W: | H:


7.23 KB | W: | H:

  • 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