shorthand.el

(require 'cl)

;;; syntax-table
(defvar shorthand-syntax-table
  (make-syntax-table))

(defmacro with-shorthand-syntax (&rest body)
  `(with-syntax-table shorthand-syntax-table
     ,@body))
(defmacro sh:syntax (&rest body)
  `(with-shorthand-syntax ,@body))

(defvar shorthand-syntax-word-chars
  "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
(defvar shorthand-syntax-symbol-chars
  "!#$%&=-^~@*:+._?/<>")
(defvar shorthand-syntax-open-paren
  "([{")
(defvar shorthand-syntax-close-paren
  ")]}")
(defvar shorthand-syntax-string-quote
  "\"'`")

(with-syntax-table shorthand-syntax-table
  ;; 単語構成文字
  (loop
   for ch across shorthand-syntax-word-chars
   do (modify-syntax-entry ch "w"))
  ;; シンボル構成文字
  (loop
   for ch across shorthand-syntax-symbol-chars
   do (modify-syntax-entry ch "_"))
  ;; 開き括弧
  (loop
   for ch across shorthand-syntax-open-paren
   do (modify-syntax-entry ch "("))
  ;; 閉じ括弧
  (loop
   for ch across shorthand-syntax-close-paren
   do (modify-syntax-entry ch ")"))
  ;; 文字列クオート
  (loop
   for ch across shorthand-syntax-string-quote
   do (modify-syntax-entry ch "\"")))



;;; メジャーモードで分けたほうがよいだろうか
(defvar shorthand:*shorthand-expand-ht*
  (make-hash-table :test 'equal))
(defvar shorthand:*shorthand-fold-ht*
  (make-hash-table :test 'equal))

(defun shorthand:add (short long)
  (interactive "sshort:\nslong:")
  (setf (gethash long shorthand:*shorthand-fold-ht*) short
	(gethash short shorthand:*shorthand-expand-ht*) long))


(fset 'sh:add #'shorthand:add)

(defun shorthand:on-symbol? ()
  (find (following-char)
	(concatenate 'string
		     shorthand-syntax-word-chars
		     shorthand-syntax-symbol-chars
		     shorthand-syntax-string-quote)))

(defun shorthand:word-at-point ()
  (with-shorthand-syntax
   (let ((s (if (shorthand:on-symbol?)
		(sexp-at-point)
	      (preceding-sexp))))
     (typecase s
       (string (format "\"%s\"" s))
       (list nil)
       (symbol (symbol-name s))
       (t nil)))))


(defun shorthand:add-at-point-short (long)
;;  (interactive "slong:")
  (interactive (list (read-from-minibuffer
		      (format "(short) %s -> (long):" (shorthand:word-at-point)))))
  (let ((short (shorthand:word-at-point)))
    (when short
      (shorthand:add short long))))
(fset 'sh:add-at-point-short #'shorthand:add-at-point-short)

(defun shorthand:add-at-point-long (short)
;;  (interactive "sshort:")
  (interactive (list (read-from-minibuffer
		      (format "(long)%s <- (short):" (shorthand:word-at-point)))))
  (let ((long (shorthand:word-at-point)))
    (when long
      (shorthand:add short long))))
(fset 'sh:add-at-point-long #'shorthand:add-at-point-long)

(defun shorthand:get (short)
  (gethash short shorthand:*shorthand-expand-ht*))
(fset 'sh:get #'shorthand:get)

(defun shorthand:get-short (long)
  (gethash long shorthand:*shorthand-fold-ht*))

(defun shorthand:expand (short)
  (interactive (list (shorthand:word-at-point)))
  (let ((long (shorthand:get short)))
    (when long
      (cond
       ((functionp long) (funcall long short))
       ((not (interactive-p)) long)
       (t (shorthand:replace (format "%s" long)))))))
(fset 'sh:expand #'shorthand:expand)

(defun shorthand:fold (long)
  (interactive (list (shorthand:word-at-point)))
  (let ((short (shorthand:get-short long)))
    (when short
      (if (not (interactive-p))
	  short
	(let ((short (format "%s" short)))
	  (shorthand:replace short))))))
(fset 'sh:fold #'shorthand:fold)

(defun shorthand:replace (new)
  (with-shorthand-syntax
   (backward-sexp)
   (kill-sexp)
   (pop kill-ring-yank-pointer)
   (let ((pos (point))
	 (len (length new)))
     (insert new)
     (goto-char (+ pos len)))))

(defvar shorthand:*expand-fold-toggle-flag* nil)

(defun shorthand:expand-and-fold ()
  (interactive)
  (if (and (eq this-command last-command) 
	   shorthand:*expand-fold-toggle-flag*)
      (progn
	(setf shorthand:*expand-fold-toggle-flag* nil)
	(command-execute 'shorthand:fold))
    (progn
      (setf shorthand:*expand-fold-toggle-flag* t)
      (command-execute 'shorthand:expand)))
  (when (interactive-p)
    (setf this-command 'shorthand:expand-and-fold)))

;; key bindings
(global-set-key (kbd "C-o") 'shorthand:expand-and-fold)
(global-set-key (kbd "M-RET") 'shorthand:add-at-point-long)
(global-set-key (kbd "M-SPC") 'shorthand:add-at-point-short)

;; example
;; (sh:add "sysout" "System.out.println")
;; sysout [M-x sh:expand] 
;; =>
;; System.out.println
;; System.out.println [M-x sh:fold]
;; =>
;; sysout


(sh:add "file:"
	(lambda (short)
	  (let ((name (read-file-name "Filename:")))
	    (when name
	      (shorthand:replace name)))))