yas-elargs.el

yas-elargs.el

(eval-when-compile (require 'cl))
(require 'yasnippet)
(require 'easy-mmode)

(defvar *yas-elargs/active* nil)

(define-minor-mode yas-elargs-mode
  "emacs lisp snippet auto generation mode"
  :init-value nil
  (if yas-elargs-mode
      (yas-elargs/enable)
    (yas-elargs/disable)))

(defvar *yas-elargs/directory*
  (concat user-emacs-directory "yas-elargs/"))

(defun yas-elargs/make-snippet (fnsym)
  (let ((args (yas-elargs/get-arguments fnsym)))
    (when args
      (save-excursion
	(yas-elargs/ensure-directory)
	(let ((buf (find-file-noselect
		    (format "%s%s.yasnippet"
			    *yas-elargs/directory*
			    (yas-elargs/slash-to-hyphen fnsym)))))
	  (with-current-buffer buf
	    (emacs-lisp-mode)
	    (yas-elargs/insert-snippet fnsym args)
	    (save-buffer)
	    (flet ((yas/compute-major-mode-and-parents (x) '(emacs-lisp-mode text-mode)))
	      (yas/load-snippet-buffer)))
	  (kill-buffer buf)))
      t)))

(defun yas-elargs/enable ()
  (set (make-local-variable '*yas-elargs/active*) t)
  (setf yas/fallback-behavior
	'(apply yas-elargs/fallback-behavior-function t)))

(defun yas-elargs/disable ()
  (interactive)
  (set (make-local-variable '*yas-elargs/active*) nil)
  (setf yas/fallback-behavior 'call-other-command))

;; fall-back-behavior
(defun yas-elargs/fallback-behavior-function (dummy)
  (let ((yas/fallback-behavior 'call-other-command))
    (let ((sym (yas-elargs/current-function-symbol)))
      (when sym
	(if (yas-elargs/already-defined sym)
	    (yas-elargs/load-snippet sym)
	  (yas-elargs/make-snippet sym)))
      (call-interactively 'yas/expand))))

;; aux
(defun yas-elargs/ensure-directory ()
  (unless (file-directory-p *yas-elargs/directory*)
    (make-directory *yas-elargs/directory*)))

(defun yas-elargs/get-arguments (sym)
  (let ((argstring (car (help-split-fundoc (documentation sym t) sym))))
    (if argstring
	(yas-elargs/parse-argstring argstring)
      (help-function-arglist sym))))

(defun yas-elargs/parse-argstring (args-string)
  (cdr (read args-string)))

(defun yas-elargs/insert-snippet (fnsym args)
  (let ((indent (get fnsym 'lisp-indent-function)))
    (save-excursion
      (let ((beg (point)))
	(insert (format "%s" fnsym))
	(let ((i 0))
	  (dotimes (n (length args))
	    (when (and (integerp indent) (= n indent))
	      (insert "\n"))
	    (let ((arg (nth n args)))
	      (unless (member arg '(&rest &optional &key &body &aux))
		(if (and arg (listp arg))
		    (progn (insert "(")
			   (dolist (a arg)
			     (insert (format " ${%d:%s}" (incf i) a)))
			   (insert ")"))
		  (insert (format " ${%d:%s}" (incf i) arg)))))))
	(insert ")")
	(indent-region beg (point))
	(goto-char (point-min))
	(insert (format
		 "#name : %s\n#condition : (and (featurep 'yas-elargs)(yas-elargs/active-p))\n"
		 fnsym))
	(insert (format "#key : %s\n# --\n" fnsym))))))

(defun yas-elargs/slash-to-hyphen (sym)
  (substitute ?- ?/ (symbol-name sym)))

(defun yas-elargs/active-p ()
  *yas-elargs/active*)

(defun yas-elargs/current-function-symbol ()
  (save-excursion
    (let ((sym (symbol-at-point)))
      (when (and sym (fboundp sym))
	(let ((pos (point)))
	  (ignore-errors (backward-sexp))
	  (when (and 
		 (string= (symbol-name sym)
			  (buffer-substring-no-properties (point) pos))
		 (and (> (point) 1) (= 40 (char-before (point)))))
	    sym))))))

(defun yas-elargs/already-defined (sym)
  (file-exists-p
   (format "%s%s.yasnippet"
	   *yas-elargs/directory*
	   (yas-elargs/slash-to-hyphen sym))))
(defun yas-elargs/load-snippet (sym)
  (let ((fname
	 (format "%s%s.yasnippet"
	   *yas-elargs/directory*
	   (yas-elargs/slash-to-hyphen sym))))
    (save-excursion
      (let ((buf (find-file-noselect fname)))
	(with-current-buffer buf
	  (flet ((yas/compute-major-mode-and-parents (x) '(emacs-lisp-mode text-mode)))
	      (yas/load-snippet-buffer)))
	(kill-buffer buf)))))


(provide 'yas-elargs)