rnchzn / scratch Goto Github PK

(defface thing-face
  '((t :background "light gray"))
  "Face for hi-lock mode." :group 'hi-lock-faces)

(defvar thing)

(put 'thing 'thing t)

(put 'thing 'face 'thing-face)

(defvar-local thing-overlay nil)

(defun thing-highlight
    (obj)
  (let*
      ((bounds
	(bounds-of-thing-at-point obj))
       ov)
    (cond
     (thing-overlay
      (move-overlay thing-overlay
		    (car bounds)
		    (cdr bounds)))
     (obj
      (setq ov
	    (make-overlay
	     (car bounds)
	     (cdr bounds)))
      (overlay-put ov 'category 'thing)
      (setq thing-overlay ov)))))

(defun thing-unhighlight nil
  (interactive)
  (when thing-overlay
    (delete-overlay thing-overlay)))


;;; thing-funs

(defun symbol-thing-forward nil
  (interactive)
  (call-interactively 'forward-symbol)
  (thing-highlight 'symbol))

(defun symbol-thing-backward nil
  (interactive)
  (call-interactively 'backward-symbol)
  (thing-highlight 'symbol))

(defun sexp-thing-forward nil
  (interactive)
  (call-interactively 'forward-sexp)
  (thing-highlight 'sexp))

(defun sexp-thing-backward nil
  (interactive)
  (call-interactively 'backward-sexp)
  (thing-highlight 'sexp))

(defun sexp-thing-up nil
  (interactive)
  (call-interactively 'backward-up-list)
  (thing-highlight 'sexp))

(defun sexp-thing-down nil
  (interactive)
  (call-interactively 'down-list)
  (thing-highlight 'sexp))


;;; definitions

(require 'thingatpt)

(define-key input-decode-map
	    (kbd "s-l")
	    (kbd "<right>"))

(defvar-keymap forward-thing-map "." 'symbol-thing-forward "x" 'sexp-thing-forward)

(global-set-key
 (kbd "<right>")
 forward-thing-map)

(define-key input-decode-map
	    (kbd "s-j")
	    (kbd "<left>"))

(defvar-keymap backward-thing-map "." 'symbol-thing-backward "x" 'sexp-thing-backward)

(global-set-key
 (kbd "<left>")
 backward-thing-map)

(define-key input-decode-map
	    (kbd "s-i")
	    (kbd "<up>"))

(defvar-keymap mark-thing-map)

(global-set-key
 (kbd "<up>")
 mark-thing-map)

(define-key input-decode-map
	    (kbd "s-k")
	    (kbd "<down>"))

(defvar-keymap beginning-thing-map)

(global-set-key
 (kbd "<down>")
 beginning-thing-map)

(defvar-keymap thing-symbol-map :repeat
	       (:enter
		(symbol-thing-forward symbol-thing-backward forward-symbol backward-symbol)
		:exit
		(sexp-thing-up))
	       "]" 'symbol-thing-forward "<right>" 'symbol-thing-forward "[" 'symbol-thing-backward "<left>" 'symbol-thing-backward "<up>" 'sexp-thing-up)

(dolist
    (fn
     '(symbol-thing-forward symbol-thing-backward forward-symbol backward-symbol sexp-thing-up))
  (put fn 'repeat-check-key 'no))

(put 'thing-symbol-map 'repeat-exit-function 'thing-unhighlight)

(defvar-keymap thing-sexp-map :repeat
	       (:enter
		(sexp-thing-forward sexp-thing-backward sexp-thing-up sexp-thing-down forward-sexp backward-sexp backward-up-list down-list)
		:exit nil)
	       "]" 'sexp-thing-forward "<right>" 'sexp-thing-forward "[" 'sexp-thing-backward "<left>" 'sexp-thing-backward "<up>" 'sexp-thing-up "<down>" 'sexp-thing-down)

(dolist
    (fn
     '(sexp-thing-forward sexp-thing-backward sexp-thing-up sexp-thing-down forward-sexp backward-sexp backward-up-list down-list))
  (put fn 'repeat-check-key 'no))

(put 'thing-sexp-map 'repeat-exit-function 'thing-unhighlight)


;;; general

(defun thing-backward
    (which-thing)
  (interactive)
  (forward-thing which-thing -1))

(defun backward-symbol nil
  (interactive)
  (thing-backward 'symbol))

(repeat-mode -1)

(repeat-mode 1)


(provide 'thing)