Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
(require 'cl)
;;; syntax-table
(defvar shorthand-syntax-table
(defmacro with-shorthand-syntax (&rest body)
`(with-syntax-table shorthand-syntax-table
(defmacro sh:syntax (&rest body)
`(with-shorthand-syntax ,@body))
(defvar shorthand-syntax-word-chars
(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
;; 単語構成文字
for ch across shorthand-syntax-word-chars
do (modify-syntax-entry ch "w"))
;; シンボル構成文字
for ch across shorthand-syntax-symbol-chars
do (modify-syntax-entry ch "_"))
;; 開き括弧
for ch across shorthand-syntax-open-paren
do (modify-syntax-entry ch "("))
;; 閉じ括弧
for ch across shorthand-syntax-close-paren
do (modify-syntax-entry ch ")"))
;; 文字列クオート
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
(defun shorthand:word-at-point ()
(let ((s (if (shorthand:on-symbol?)
(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
((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))
(let ((short (format "%s" short)))
(shorthand:replace short))))))
(fset 'sh:fold #'shorthand:fold)
(defun shorthand:replace (new)
(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 ()
(if (and (eq this-command last-command)
(setf shorthand:*expand-fold-toggle-flag* nil)
(command-execute 'shorthand:fold))
(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)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.