mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-06 02:30:31 -08:00
76 lines
2.5 KiB
Common Lisp
76 lines
2.5 KiB
Common Lisp
;;;
|
|
;;; Send EQL code to "local-server": a trivial one-way use of EQL from any CL
|
|
;;;
|
|
;;;
|
|
;;; Run: (after building the executable in "send/")
|
|
;;;
|
|
;;; eql local-server.lisp
|
|
;;; ecl -load send.lisp / clisp -i send.lisp / sbcl --load send.lisp
|
|
;;;
|
|
;;;
|
|
;;; Examples: (note #!)
|
|
;;;
|
|
;;; #q (qmsg (package-name *package*))
|
|
;;;
|
|
;;; #q (qmsg #!(package-name *package*))
|
|
;;;
|
|
;;; (let ((a 1)
|
|
;;; (b 2))
|
|
;;; #q (qmsg (list #!a #!b)))
|
|
;;;
|
|
;;; (defun msg (x)
|
|
;;; #q (qmsg #!x))
|
|
;;;
|
|
;;; #q (load "../2-clock.lisp")
|
|
;;; #q (! "showMaximized" clock:*clock*)
|
|
|
|
(set-dispatch-macro-character #\# #\q (lambda (stream c n) (%read-q stream)))
|
|
|
|
(defmacro while-it (exp &body body)
|
|
`(do ((it))
|
|
((not (setf it ,exp)))
|
|
,@body))
|
|
|
|
(defun %read-q (in)
|
|
(let ((string-q (with-output-to-string (out)
|
|
(let ((ex #\Space)
|
|
parens in-string)
|
|
(loop
|
|
(let ((ch (read-char in)))
|
|
(write-char ch out)
|
|
(unless (char= #\\ ex)
|
|
(if (char= #\" ch)
|
|
(setf in-string (not in-string))
|
|
(unless in-string
|
|
(case ch
|
|
(#\( (if parens (incf parens) (setf parens 1)))
|
|
(#\) (decf parens)))
|
|
(when (and parens (zerop parens))
|
|
(return)))))
|
|
(setf ex ch))))))
|
|
list-q)
|
|
(while-it (search "#!" string-q)
|
|
(multiple-value-bind (exp end)
|
|
(read-from-string (subseq string-q (+ it 2)))
|
|
(unless (zerop it)
|
|
(push (subseq string-q 0 it) list-q))
|
|
(push (list 'prin1-to-string exp) list-q)
|
|
(setf string-q (subseq string-q (+ it 2 end)))))
|
|
(push string-q list-q)
|
|
`(send-q (list ,@(reverse list-q)))))
|
|
|
|
(defun send-q (data)
|
|
(#+ecl ext:run-program
|
|
#+clisp run-program
|
|
#+sbcl sb-ext:run-program
|
|
#+darwin "./send/send.app/Contents/MacOS/send"
|
|
#+(and unix (not darwin)) "./send/send"
|
|
#+win32 "send/send.exe"
|
|
#+clisp :arguments
|
|
(list (etypecase data
|
|
(string
|
|
data)
|
|
(list
|
|
(format nil "~{~A~^ ~}" (mapcar (lambda (x) (string-trim " " x)) data)))))
|
|
#+ecl :error #+ecl nil))
|
|
|