Skip to content

Instantly share code, notes, and snippets.

@dleslie
Created April 3, 2012 00:43
Show Gist options
  • Save dleslie/2288338 to your computer and use it in GitHub Desktop.
Save dleslie/2288338 to your computer and use it in GitHub Desktop.
Dan's Custom Scheme for Emacs
(require 'paredit)
(require 'auto-complete)
(require 'auto-complete-etags)
(require 'yasnippet-bundle)
(require 'scheme)
;; Some utilities of mine
(defun add-font-lock-keywords (modes new-keywords)
(mapc (lambda (mode)
(font-lock-add-keywords mode `((, (concat "(\\(" (regexp-opt (mapcar 'symbol-name (remove-if 'numberp new-keywords)) t) "\\)\\>")
(1 font-lock-keyword-face)))))
modes)
t)
(defun remove-font-lock-keywords (modes new-keywords)
(mapc (lambda (mode)
(font-lock-remove-keywords mode `((, (concat "(\\(" (regexp-opt (mapcar 'symbol-name (remove-if 'numberp new-keywords)) t) "\\)\\>")
(1 font-lock-keyword-face)))))
modes)
t)
;; Set this to a target etags file of your choosing
(defcustom chicken-scheme-tags-file nil
"Extra tags file to load for pattern matching and syntax hilighting"
:type '(string)
:group 'chicken-scheme)
;; Hardcoded r5rs-symbols
(setq r5rs-symbols '(abs acos and angle append apply asin assoc assq assv atan begin boolean? caar cadr call-with-current-continuation call-with-input-file call-with-output-file call-with-values car case cdddar cddddr cdr ceiling char->integer char-alphabetic? char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case? char-numeric? char-ready? char-upcase char-upper-case? char-whitespace? char<=? char<? char=? char>=? char>? char? close-input-port close-output-port complex? cond cons cos current-input-port current-output-port define define-syntax delay denominator display do dynamic-wind else eof-object? eq? equal? eqv? eval even? exact->inexact exact? exp expt floor for-each force gcd if imag-part inexact->exact inexact? input-port? integer->char integer? interaction-environment lambda lcm length let let* let-syntax letrec letrec-syntax list list->string list->vector list-ref list-tail list? load log magnitude make-polar make-rectangular make-string make-vector map max member memq memv min modulo negative? newline not null-environment null? number->string number? numerator odd? open-input-file open-output-file or output-port? pair? peek-char port? positive? procedure? quasiquote quote quotient rational? rationalize read read-char real-part real? remainder reverse round scheme-report-environment set! set-car! set-cdr! setcar sin sqrt string string->list string->number string->symbol string-append string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>? string-copy string-fill! string-length string-ref string-set! string<=? string<? string=? string>=? string>? string? substring symbol->string symbol? syntax-rules tan transcript-off transcript-on truncate values vector vector->list vector-fill! vector-length vector-ref vector-set! vector? with-input-from-file with-output-to-file write write-char zero?))
(defun load-scheme-tags (scheme-tags-location)
(interactive)
(let ((existing-tags tags-table-list))
(setq tags-table-list nil)
(visit-tags-table scheme-tags-location)
(tags-completion-table)
(add-font-lock-keywords '(scheme-mode inferior-scheme-mode) tags-completion-table)
(setq tags-table-list existing-tags))
t)
(defun chicken-modules ()
(interactive "r")
(let ((default-directory "~/")
modules)
(with-temp-buffer
(insert (shell-command-to-string "chicken-status -files"))
(beginning-of-buffer)
(while (re-search-forward "/\\([^/\.]+\\)\\.so" nil t)
(when (match-string 0)
(if (and (not (equalp "chicken-doc" (match-string 1))) ; Doesn't play well with csi in emacs?
(not (equalp "chicken-doc-text" (match-string 1)))
(not (equalp "bind-translator" (match-string 1))))
(push (match-string 1) modules)))))
modules))
(defvar ac-chicken-symbols-source
(eval
(read
(concat "'"
(shell-command-to-string
(format "csi -q -w -e \"(use %s)\" -e \"(display (map car (##sys#macro-environment)))\" -e \"(display (##sys#environment-symbols (interaction-environment)))\""
(mapconcat 'identity (chicken-modules) " ")))))))
(defun all-chicken-symbols ()
(delete-dups (append r5rs-symbols ac-chicken-symbols-source)))
(defun ac-chicken-symbols-candidates ()
(delq nil
(mapcar '(lambda (s) (let ((n (symbol-name s)))
(cons n n)))
(all-chicken-symbols))))
(defface ac-chicken-scheme-candidate-face
'((t (:inherit 'ac-candidate-face)))
"Face for chicken scheme candidate menu."
:group 'chicken-scheme)
(defface ac-chicken-scheme-selection-face
'((t (:inherit 'ac-selection-face)))
"Face for the chicken scheme selected candidate."
:group 'chicken-scheme)
(defun ac-chicken-doc (symbol-name)
(shell-command-to-string (format "chicken-doc %s" (substring-no-properties symbol-name))))
(defun load-chicken-keywords ()
(interactive "r")
(add-font-lock-keywords '(scheme-mode) (all-chicken-symbols)))
(defvar ac-source-scheme-symbols
'((candidates . ac-chicken-symbols-candidates)
(candidate-face . ac-chicken-scheme-candidate-face)
(selection-face . ac-chicken-scheme-selection-face)
(symbol . "c")
(requires . 2)
(document . ac-chicken-doc)))
(add-hook 'scheme-mode-hook
'(lambda ()
(enable-paredit-mode)
(if chicken-scheme-tags-file
(load-scheme-tags scheme-tags-file))
(setq ac-sources
'(ac-source-scheme-symbols
ac-source-words-in-buffer
))
(load-chicken-keywords)
))
(provide 'custom-scheme)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment