dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

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)