You are looking at historical revision 26348 of this page. It may differ significantly from its current revision.

Author: Dan Leslie, <>

I do a fair bit of Chicken hacking in my free time as a hobby. Sadly, there wasn't much in the way of excellent tools for this purpose when I began. Largely, in part, because I was never able to get slime to play well with Emacs and Chicken under Windows.

To rectify this I put in some time to get my Emacs environment working nicely. The end result is a customized scheme-mode that automatically loads all symbols from csi and your installed modules and adds them to the auto-complete list. It also uses these details to add new font-lock keywords!

Optionally, you can also tell it (via a custom var) where to look for a TAGS file to slurp symbols from.

The major bug I'm aware of is that the font-lock symbols get blown away on file load, so you may have to manually reload scheme-mode to reinit the symbols. You could also call M-x load-chicken-keywords

If you figure out how to fix this please let me know!

Without further ado, the elisp:

(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)))))

(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)))))

; 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)

(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)
  (let ((existing-tags tags-table-list))
    (setq tags-table-list nil)
    (visit-tags-table scheme-tags-location)
    (add-font-lock-keywords '(scheme-mode inferior-scheme-mode) tags-completion-table)
    (setq tags-table-list existing-tags))

(defun chicken-modules ()
  (interactive "r")
  (let ((default-directory "~/")
      (insert (shell-command-to-string "chicken-status -files"))
      (while (re-search-forward "\\([^/\]+\\).import" 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 "allegro" (match-string 1))) ; Has problems with csi in emacs on windows
                   (not (equalp "sfml" (match-string 1))) ; Has problems with csi in emacs on windows
                   (not (equalp "bind-translator" (match-string 1))))
              (push (match-string 1) modules)))))

(defun chicken-symbols ()
  (interactive "r")
  (let ((modules (mapconcat 'identity (chicken-modules) " "))
      (insert (shell-command-to-string (format "csi -e \"(use %s)\" -e \"(map car (##sys#macro-environment))\"" modules)))
      (while (re-search-forward "[^ ()]+" nil t)
        (when (match-string 0)
          (push (make-symbol (match-string 0)) symbols))))

(defun ac-chicken-symbols-source ()
  (let ((modules (mapconcat 'identity (chicken-modules) " ")))
    (eval (read (concat "'" (shell-command-to-string (format "csi -q -w -e \"(use %s)\" -e \"(display (map car (##sys#macro-environment)))\"" modules)))))))

(defun all-chicken-symbols ()
   (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)))
                (append r5rs-symbols (ac-chicken-symbols-source)))))

(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)

(defvar ac-source-scheme-symbols
  '((init . (lambda () t))
    (candidates . ac-chicken-symbols-candidates)
    (candidate-face . ac-chicken-scheme-candidate-face)
    (selection-face . ac-chicken-scheme-selection-face)
    (symbol . "c")
    ;(prefix . "\\\\\\(.*\\)")
  "Source for chicken scheme completions")

(defun load-chicken-keywords ()
  (interactive "r")
  (add-font-lock-keywords '(scheme-mode) (all-chicken-symbols)))

(defvar chicken-scheme-font-lock-keywords
  (append scheme-font-lock-keywords-2
             "(" (regexp-opt
                  (mapcar 'symbol-name (all-chicken-symbols))
             "\\>") 1)
  "Chicken scheme keywords.")

(add-hook 'scheme-mode-hook
          '(lambda ()
                        (if chicken-scheme-tags-file
                            (load-scheme-tags scheme-tags-file))
                        (make-local-variable 'ac-sources)   
                        (setq ac-sources 

(provide 'custom-scheme)