dotemacs

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

sly-macrostep.el (5828B)


      1 ;;; sly-macrostep.el --- fancy macro-expansion via macrostep.el
      2 ;;
      3 ;; Version: 0.1
      4 ;; URL: https://github.com/capitaomorte/sly-macrostep
      5 ;; Keywords: languages, lisp, sly
      6 ;; Package-Requires: ((sly "1.0.0-beta2") (macrostep "0.9"))
      7 ;; Authors: Luís Oliveira <luismbo@gmail.com>, Jon Oddie <j.j.oddie@gmail.com, João Távora <joaotavora@gmail.com>
      8 ;;
      9 ;; Copyright (C) 2016 the authors
     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 ;;; Description:
     25 ;;
     26 ;; This is the SLY port of a contrib originally written for SLIME,
     27 ;; with minimal changes, mostly "slime"->"sly" replacements.
     28 ;;
     29 ;; Fancier in-place macro-expansion using macrostep.el (originally
     30 ;; written for Emacs Lisp).  To use, position point before the
     31 ;; open-paren of the macro call in a SLY source or REPL buffer, and
     32 ;; type `C-c M-e' or `M-x macrostep-expand'.  The pretty-printed
     33 ;; result of `macroexpand-1' will be inserted inline in the current
     34 ;; buffer, which is temporarily read-only while macro expansions are
     35 ;; visible.  If the expansion is itself a macro call, expansion can be
     36 ;; continued by typing `e'.  Expansions are collapsed to their
     37 ;; original macro forms by typing `c' or `q'.  Other macro- and
     38 ;; compiler-macro calls in the expansion will be font-locked
     39 ;; differently, and point can be moved there quickly by typing `n' or
     40 ;; `p'.  For more details, see the documentation of
     41 ;; `macrostep-expand'.
     42 
     43 ;;; Code:
     44 
     45 (require 'sly)
     46 (require 'macrostep)
     47 (require 'cl-lib)
     48 
     49 (define-sly-contrib sly-macrostep
     50   "Interactive macro expansion via macrostep.el."
     51   (:authors "Luís Oliveira       <luismbo@gmail.com>"
     52             "Jon Oddie           <j.j.oddie@gmail.com>")
     53   (:license "GPL")
     54   (:slynk-dependencies slynk-macrostep)
     55   (:on-load
     56    (easy-menu-add-item sly-mode-map '(menu-bar SLY Debugging)
     57                        ["Macro stepper..." macrostep-expand (sly-connected-p)])
     58    (add-hook 'sly-editing-mode-hook #'sly-macrostep-mode-hook)
     59    (define-key sly-editing-mode-map (kbd "C-c M-e") #'macrostep-expand)
     60    (eval-after-load 'sly-mrepl
     61      '(progn
     62        (add-hook 'sly-mrepl-mode-hook #'sly-macrostep-mode-hook)
     63        (define-key sly-mrepl-mode-map (kbd "C-c M-e") #'macrostep-expand)))))
     64 
     65 (defun sly-macrostep-mode-hook ()
     66   (setq macrostep-sexp-at-point-function #'sly-macrostep-sexp-at-point)
     67   (setq macrostep-environment-at-point-function #'sly-macrostep-context)
     68   (setq macrostep-expand-1-function #'sly-macrostep-expand-1)
     69   (setq macrostep-print-function #'sly-macrostep-insert)
     70   (setq macrostep-macro-form-p-function #'sly-macrostep-macro-form-p))
     71 
     72 (defun sly-macrostep-sexp-at-point (&rest _ignore)
     73   (sly-sexp-at-point))
     74 
     75 (defun sly-macrostep-context ()
     76   (let (defun-start defun-end)
     77     (save-excursion
     78       (while
     79           (condition-case nil
     80               (progn (backward-up-list) t)
     81             (scan-error nil)))
     82       (setq defun-start (point))
     83       (setq defun-end (scan-sexps (point) 1)))
     84     (list (buffer-substring-no-properties
     85            defun-start (point))
     86           (buffer-substring-no-properties
     87            (scan-sexps (point) 1) defun-end))))
     88 
     89 (defun sly-macrostep-expand-1 (string context)
     90   (sly-dcase
     91       (sly-eval
     92        `(slynk-macrostep:macrostep-expand-1
     93          ,string ,macrostep-expand-compiler-macros ',context))
     94     ((:error error-message)
     95      (error "%s" error-message))
     96     ((:ok expansion positions)
     97      (list expansion positions))))
     98 
     99 (defun sly-macrostep-insert (result _ignore)
    100   "Insert RESULT at point, indenting to match the current column."
    101   (cl-destructuring-bind (expansion positions) result
    102     (let ((start (point))
    103           (column-offset (current-column)))
    104       (insert expansion)
    105       (sly-macrostep--propertize-macros start positions)
    106       (indent-rigidly start (point) column-offset))))
    107 
    108 (defun sly-macrostep--propertize-macros (start-offset positions)
    109   "Put text properties on macro forms."
    110   (dolist (position positions)
    111     (cl-destructuring-bind (operator type start)
    112         position
    113       (let ((open-paren-position
    114               (+ start-offset start)))
    115         (put-text-property open-paren-position
    116                            (1+ open-paren-position)
    117                            'macrostep-macro-start
    118                            t)
    119         ;; this assumes that the operator starts right next to the
    120         ;; opening parenthesis. We could probably be more robust.
    121         (let ((op-start (1+ open-paren-position)))
    122           (put-text-property op-start
    123                              (+ op-start (length operator))
    124                              'font-lock-face
    125                              (if (eq type :macro)
    126                                  'macrostep-macro-face
    127                                  'macrostep-compiler-macro-face)))))))
    128 
    129 (defun sly-macrostep-macro-form-p (string context)
    130   (sly-dcase
    131       (sly-eval
    132        `(slynk-macrostep:macro-form-p
    133          ,string ,macrostep-expand-compiler-macros ',context))
    134     ((:error error-message)
    135      (error "%s" error-message))
    136     ((:ok result)
    137      result)))
    138 
    139 
    140 
    141 ;;; Automatically add ourselves to `sly-contribs' when this file is loaded
    142 ;;;###autoload
    143 (with-eval-after-load 'sly
    144   (add-to-list 'sly-contribs 'sly-macrostep 'append))
    145 
    146 (provide 'sly-macrostep)
    147 ;;; sly-macrostep.el ends here