slynk-named-readtables.lisp (1597B)
1 (defpackage #:slynk-named-readtables (:use :cl #:slynk-api)) 2 (in-package #:slynk-named-readtables) 3 4 (defvar *find-readtable-function* nil 5 "Function taking a string designating a readtable. 6 The function should return a READTABLEP object") 7 8 (defun find-readtable-by-name (string) 9 "Find a readtable corresponding to STRING." 10 (when string 11 (if *find-readtable-function* 12 (funcall *find-readtable-function* string) 13 (let* ((find-readtable-fn (and (find-package :editor-hints.named-readtables) 14 (find-symbol "FIND-READTABLE" :editor-hints.named-readtables))) 15 (readtable-designator 16 (and find-readtable-fn 17 string 18 (with-buffer-syntax () 19 (let ((*read-eval* nil)) 20 ;; JT@15/08/13: Perhaps READ-FROM-STRING is 21 ;; questionable here... 22 (read-from-string string)))))) 23 (funcall find-readtable-fn readtable-designator))))) 24 25 26 (defun wrap-in-named-readtable (in-function &key (named-readtable nil) 27 &allow-other-keys) 28 "Wrap IN-FUNCTION in readtable named by NAMED-READTABLE, a string." 29 (let* ((guess (and named-readtable 30 (find-readtable-by-name named-readtable)))) 31 (lambda () 32 (let ((*buffer-readtable* (or guess 33 *buffer-readtable*))) 34 (funcall in-function))))) 35 36 (pushnew 'wrap-in-named-readtable *eval-for-emacs-wrappers*) 37 38 (provide 'slynk-named-readtables)