From 2d30daecad657d692a7f3cb66deb496630362600 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 24 May 2010 00:03:30 +0200 Subject: Racket: PLT implementation renamed to Racket. --- elisp/geiser-racket.el | 209 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 209 insertions(+) create mode 100644 elisp/geiser-racket.el (limited to 'elisp/geiser-racket.el') diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el new file mode 100644 index 0000000..dd086a5 --- /dev/null +++ b/elisp/geiser-racket.el @@ -0,0 +1,209 @@ +;; geiser-racket.el -- geiser support for Racket scheme + +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see . + +;; Start date: Sat Apr 25, 2009 21:13 + + + +(require 'geiser-edit) +(require 'geiser-doc) +(require 'geiser-eval) +(require 'geiser-syntax) +(require 'geiser-custom) +(require 'geiser-base) + + +;;; Customization: + +(defgroup geiser-racket nil + "Customization for Geiser's Racket flavour." + :group 'geiser) + +(geiser-custom--defcustom geiser-racket-binary + (cond ((eq system-type 'windows-nt) "Racket.exe") + ((eq system-type 'darwin) "racket") + (t "racket")) + "Name to use to call the mzscheme executable when starting a REPL." + :type '(choice string (repeat string)) + :group 'geiser-racket) + +(geiser-custom--defcustom geiser-racket-collects nil + "A list of paths to be added to mzscheme's collection directories." + :type '(repeat file) + :group 'geiser-racket) + +(geiser-custom--defcustom geiser-racket-init-file "~/.racket-geiser" + "Initialization file with user code for the mzscheme REPL." + :type 'string + :group 'geiser-racket) + + + +;;; REPL support: + +(defun geiser-racket--binary () + (if (listp geiser-racket-binary) + (car geiser-racket-binary) + geiser-racket-binary)) + +(defun geiser-racket--parameters () + "Return a list with all parameters needed to start mzscheme. +This function uses `geiser-racket-init-file' if it exists." + (let ((init-file (and (stringp geiser-racket-init-file) + (expand-file-name geiser-racket-init-file)))) + `("-i" "-q" + "-S" ,(expand-file-name "racket/" geiser-scheme-dir) + ,@(apply 'append (mapcar (lambda (p) (list "-S" p)) geiser-racket-collects)) + ,@(and (listp geiser-racket-binary) (cdr geiser-racket-binary)) + ,@(and init-file (file-readable-p init-file) (list "-f" init-file)) + "-f" ,(expand-file-name "racket/geiser.rkt" geiser-scheme-dir)))) + +(defconst geiser-racket--prompt-regexp "^=?\\(mzscheme\\|racket\\)@[^ ]*?> ") + + +;;; Evaluation support: + +(defun geiser-racket--language () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + "^\\(?:#lang\\|(module +[^ ]+?\\) +\\([^ ]+?\\|([^)]+)\\) *$" nil t) + (car (geiser-syntax--read-from-string (match-string-no-properties 1))) + :f))) + +(defun geiser-racket--geiser-procedure (proc) + (if (memq proc '(eval compile)) + `((dynamic-require 'geiser 'geiser:eval) ',(geiser-racket--language)) + `(dynamic-require 'geiser ',(intern (format "geiser:%s" proc))))) + +(defconst geiser-racket--module-re + "^(module +\\([^ ]+\\)") + +(defun geiser-racket--explicit-module () + (save-excursion + (goto-char (point-min)) + (and (re-search-forward geiser-racket--module-re nil t) + (ignore-errors + (car (geiser-syntax--read-from-string + (match-string-no-properties 1))))))) + +(defsubst geiser-racket--implicit-module () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^#lang " nil t) + (buffer-file-name) + :f))) + +(defun geiser-racket--get-module (&optional module) + (cond ((and (null module) (buffer-file-name))) + ;; (geiser-racket--explicit-module) + ((null module) (geiser-racket--implicit-module)) + ((symbolp module) module) + ((and (stringp module) (file-name-absolute-p module)) module) + ((stringp module) (intern module)) + (t nil))) + +(defun geiser-racket--symbol-begin (module) + (save-excursion (skip-syntax-backward "^-()>") (point))) + +(defun geiser-racket--enter-command (module) + (and (stringp module) (format "(enter! (file %S))" module))) + +(defconst geiser-racket--binding-forms + '(for for/list for/hash for/hasheq for/and for/or + for/lists for/first for/last for/fold)) + +(defconst geiser-racket--binding-forms* + '(for* for*/list for*/lists for*/hash for*/hasheq for*/and + for*/or for*/first for*/last for*/fold)) + +;;; External help + +(defsubst geiser-racket--get-help (symbol module) + (geiser-eval--send/wait + `(:eval (get-help ',symbol (:module ,module)) geiser/autodoc))) + +(defun geiser-racket--external-help (id module) + (message "Requesting help for '%s'..." id) + (let ((out (geiser-eval--retort-output + (geiser-racket--get-help id module)))) + (when (and out (string-match " but provided by:\n +\\(.+\\)\n" out)) + (geiser-racket--get-help symbol (match-string 1 out)))) + (minibuffer-message "%s done" (current-message)) + t) + + +;;; Error display + +(defconst geiser-racket--file-rxs + '("^\\([^:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)" + "path:\"?\\([^>\"\n]+\\)\"?>" + "module: \"\\([^>\"\n]+\\)\"")) + +(defun geiser-racket--find-files (rx) + (save-excursion + (while (re-search-forward rx nil t) + (geiser-edit--make-link (match-beginning 1) + (match-end 1) + (match-string 1) + (match-string 2) + (match-string 3))))) + +(defun geiser-racket--display-error (module key msg) + (when key + (insert "Error: ") + (geiser-doc--insert-button key nil 'racket) + (newline 2)) + (when msg + (let ((p (point))) + (insert msg) + (when key + (let ((end (point))) + (goto-char p) + (mapc 'geiser-racket--find-files geiser-racket--file-rxs) + (goto-char end) + (newline))))) + t) + + +;;; Trying to ascertain whether a buffer is mzscheme scheme: + +(defun geiser-racket--guess () + (or (save-excursion + (goto-char (point-min)) + (re-search-forward "#lang " nil t)) + (geiser-racket--explicit-module))) + + +;;; Implementation definition: + +(define-geiser-implementation racket + (unsupported-procedures '(callers callees generic-methods)) + (binary geiser-racket--binary) + (arglist geiser-racket--parameters) + (startup) + (prompt-regexp geiser-racket--prompt-regexp) + (marshall-procedure geiser-racket--geiser-procedure) + (find-module geiser-racket--get-module) + (enter-command geiser-racket--enter-command) + (find-symbol-begin geiser-racket--symbol-begin) + (display-error geiser-racket--display-error) + (display-help geiser-racket--external-help) + (check-buffer geiser-racket--guess) + (binding-forms geiser-racket--binding-forms) + (binding-forms* geiser-racket--binding-forms*)) + +(geiser-impl--add-to-alist 'regexp + "\\.\\(mzscheme\\|racket\\)\\.sl?s$" 'racket t) +(geiser-impl--add-to-alist 'regexp "\\.ss$" 'racket t) +(geiser-impl--add-to-alist 'regexp "\\.rkt$" 'racket t) + + +(provide 'geiser-racket) +;;; geiser-racket.el ends here -- cgit v1.2.3