dotemacs

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

sly-named-readtables.el (4649B)

      1 ;;; sly-named-readtables.el --- Support named readtables in Common Lisp files  -*- lexical-binding: t; -*-
      2 ;;
      3 ;; Version: 0.1
      4 ;; URL: https://github.com/capitaomorte/sly-named-readtables
      5 ;; Keywords: languages, lisp, sly
      6 ;; Package-Requires: ((sly "1.0.0-beta2"))
      7 ;; Author: João Távora <joaotavora@gmail.com>
      8 ;; 
      9 ;; Copyright (C) 2015 João Távora
     10 ;;
     11 ;; This file is free software; you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 ;;
     16 ;; This program is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 ;;
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     23 ;;
     24 ;;; Commentary:
     25 ;;; 
     26 ;; An external contrib for SLY that enables different readtables to be
     27 ;; active in different parts of the same file. 
     28 ;;
     29 ;; SLY lives at https://github.com/capitaomorte/sly.
     30 ;; 
     31 ;;; Installation:
     32 ;;
     33 ;; Since this is an external contrib with both Elisp and Lisp parts,
     34 ;; merely loading the Elisp will have little effect. The contrib has
     35 ;; to be registered in SLY's `sly-contribs' variable for SLY to take care
     36 ;; of loading the Lisp side on demand.
     37 ;;
     38 ;; For convenience, the `sly-named-readtables-autoloads.el' Elisp file
     39 ;; takes care of this automatically. So in your `~/.emacs' or
     40 ;; `~/.emacs.d/init/el' init file:
     41 ;; 
     42 ;; (setq inferior-lisp-program "/path/to/your/preferred/lisp")
     43 ;; (add-to-list 'load-path "/path/to/sly")
     44 ;; (require 'sly-autoloads)
     45 ;;  
     46 ;; (add-to-list 'load-path "/path/to/sly-named-readtables")
     47 ;; (require 'sly-named-readtables-autoloads)
     48 ;;
     49 ;; In case you already have SLY loaded and/or running, you might have to
     50 ;; `M-x sly-setup' and `M-x sly-enable-contrib' to enable it.
     51 ;;  
     52 ;; `sly-named-readtables' should now kick in in Lisp buffers. You must
     53 ;; have `named-readtables` setup in your Lisp before it takes any actual
     54 ;; effect though. That's easy, just `(ql:quickload :named-readtables)'.
     55 ;; 
     56 ;;; Code:
     57 
     58 (require 'sly)
     59 
     60 (define-sly-contrib sly-named-readtables
     61   "Automatically parse in-readtable forms in Lisp buffers"
     62   (:slynk-dependencies slynk-named-readtables)
     63   (:on-load (add-hook 'sly-editing-mode-hook 'sly-named-readtables-mode))
     64   (:on-unload (remove-hook 'sly-editing-mode-hook 'sly-named-readtables-mode)))
     65 
     66 (defun sly-named-readtable--pretty-name (name)
     67   ;; Let's leave this abstraction in place for now...
     68   name)
     69 
     70 (define-minor-mode sly-named-readtables-mode
     71   "Use EDITOR-HINTS.NAMED-READTABLES if available."
     72   nil nil nil
     73   (cond (sly-named-readtables-mode
     74          (add-to-list 'sly-extra-mode-line-constructs
     75                       'sly-named-readtables--mode-line-construct
     76                       t)
     77          (add-to-list 'sly-rex-extra-options-functions
     78                       'sly-named-readtables--pass-readtable
     79                       t))
     80         (t
     81          (setq sly-extra-mode-line-constructs
     82                (delq 'sly-named-readtables--mode-line-construct
     83                      sly-extra-mode-line-constructs)
     84                sly-rex-extra-options-functions
     85                (delq 'sly-named-readtables--pass-readtable
     86                      sly-rex-extra-options-functions)))))
     87 
     88 (defun sly-named-readtables--grok-current-table ()
     89   (let ((case-fold-search t)
     90         (regexp (concat "^(\\(named-readtables:\\)?in-readtable\\>[ \t\n]*"
     91                         "\\([^)]+\\)[ \t]*)")))
     92     (save-excursion
     93       (when (re-search-backward regexp nil t)
     94         (match-string-no-properties 2)))))
     95 
     96 (defun sly-named-readtables--mode-line-construct ()
     97   (let ((readtable-name (sly-named-readtables--grok-current-table)))
     98     `(:propertize ,(or (and readtable-name
     99                             (sly-named-readtable--pretty-name readtable-name))
    100                        "*")
    101                   face ,(if readtable-name 'hi-pink 'sly-mode-line)
    102                   mouse-face mode-line-highlight
    103                   help-echo ,(if readtable-name
    104                                  (format "Special NAMED-READTABLE %s" readtable-name)
    105                                "Default readtable"))))
    106 
    107 (defun sly-named-readtables--pass-readtable ()
    108   (list :named-readtable (sly-named-readtables--grok-current-table)))
    109 
    110 ;;;###autoload
    111 (with-eval-after-load 'sly
    112   (add-to-list 'sly-contribs 'sly-named-readtables 'append))
    113 
    114 (provide 'sly-named-readtables)
    115 ;;; sly-named-readtables.el ends here
    116