gaucheの補完用のelispを書いたりした

説明とか(あとで書く)

作ったもの

  • get-procedure-list.scm
  • gauche-completion.el

get-procedure-list.scm

(use file.util)
(use srfi-1)

(define (%filter file)
  (guard (e (else '()))
    (call-with-input-file file
      (lambda (in)
        (port-fold (lambda (line it)
                     (let1 re (rxmatch #/\(define-module \S+/ line)
                       (if re (cons (re 0) it) it)))
                   '() (cut read-line in))))))
(define (search-module d)
  (directory-fold d (lambda (f it)
                      (if (equal? (path-extension f) "scm")
                        (let1 re (%filter f)
                          (if re (cons re it) it))
                        it)) '()))

(define (flatten! l)
  (if (list? l)
      (apply append! (map! flatten! l))
      (list l)))

(define (layout! str)
  (regexp-replace-all* str #/define-module/ "use" #/($|\)$)/ ")"))

(define (with-result fn args)
      (let1 dirs (if (null? args) *load-path* args)
        (let1 l (flatten! (map! search-module dirs))
          (fn (map! layout! (delete-duplicates! l))))))

(define (output . args)
  (with-result (lambda (re) (for-each print re)) args))

(define (make-candidate . args)
  (with-result
   (lambda (re)
     (flatten! 
      (map! (lambda (exp)
              (guard (e (else '()))
                (let1 m ((rxmatch  #/use (\S+)\)/ exp) 1)
                  (eval (read-from-string exp) (interaction-environment))
                  (let1 fns (module-exports (find-module (string->symbol m)))
                    (map! (cut format #f "\"~A\t[[~A]]\"" <> m) fns)))))
            re)))
  args))

(define (main args)
  (print
   (apply make-candidate 
          (if (null? (cdr args)) *load-path* (cdr args)))
       )
   0)

gauche-completion.el

;; (setq gauche-module-search-program "~/.emacs.d/get-procedure-list.scm")
;; (add-hook 'scheme-mode-hook
;; 	  (lambda ()
;; 	    (define-key scheme-mode-map "\C-c\C-j" 'anything-gauche-completion)))
;;
;; M-x list-gauche-procedure
;; M-x gauche-completion--remove-list

(defvar gauche-module-search-program "*.scm")
(defvar gauche-completion-source nil)
(defvar gauche-program-argument "")	; "-I <your own libraly .etc>
(defvar gauche-procedure-peace "")

(setq gauche-completion-c-source
      '((name . "procedure")
	(candidates . (lambda () (gauche-completion-source)))
	(action . (("insert" . (lambda (c)
				 (let ((n (length gauche-procedure-peace))
				       (str (car (split-string c "\t"))))
				   (delete-backward-char n)
				   (insert str))))))))

(defun gauche-completion-source ()
  (or gauche-completion-source
      (progn
	(setq gauche-completion-source
	      (gauche-completion--fill-sources))
	gauche-completion-source)))

(defun gauche-completion--run-script (file &optional last-arg)
  (let ((program (if (boundp 'gauche-program)
		     gauche-program
		   "gosh"))
	(last-arg (or last-arg "2>/dev/null")))
    (shell-command-to-string
     (format "%s %s %s %s" program gauche-program-argument file last-arg))))


(defun gauche-completion--remove-list () (interactive)
  (setq gauche-completion-c-source nil))

(defun gauche-completion--fill-sources ()
  (read (gauche-completion--run-script gauche-module-search-program)))



(defun gauche-current-procedure ()
  (save-excursion
    (let ((syntax "w_"))
      (let ((end (point)))
	(skip-syntax-backward syntax)
	(let ((start (point)))
	  (buffer-substring-no-properties start end))))))

(defun anything-gauche-completion () (interactive)
  (unwind-protect
      (progn
	(setq gauche-procedure-peace (concat (gauche-current-procedure) ".*"))
	(anything (list gauche-completion-c-source) gauche-procedure-peace))
    (setq gauche-procedure-peace "")))

(defun list-gauche-procedure () (interactive)
  (let ((current-module ""))
    (with-output-to-temp-buffer "*procedure*"
      (dolist (e gauche-completion-source)
	(let ((s (split-string e "\t")))
	  (let ((p (car s)) (m (cadr s)))
	    (unless (equal m current-module)
	      (princ "\n")
	      (setq current-module m)
	      (princ (format "== %s ==\n" m)))
	    (princ (concat p ", ")))))
      )))