Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 173 lines (149 sloc) 5.254 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
;;; jaunte.el --- Emacs Hit a Hint

;; 参考
;; yafastnav.el
;; vimperator

;; 設定
;; (require 'jaunte)
;; (global-set-key (kbd "C-c C-j") 'jaunte)

(defvar jaunte-keys (mapcar #'identity "jklasdfghyuiopqwertnmzxcvb"))

(defface jaunte-hint-face
  '((t
     (:foreground "white"
      :background "blue"
      :italic nil
      :bold nil)))
  nil)

(defface jaunte-hint-face2
  '((t
     (:foreground "white"
      :background "royalblue"
      :italic nil
      :bold nil)))
  nil)

(defvar jaunte-hint-faces '(jaunte-hint-face jaunte-hint-face2))

(defun jaunte-cycle-reset (symbol)
  (put symbol 'jaunte-cycle-index 0))

(defun jaunte-cycle (symbol)
  (let ((index (or (get symbol 'jaunte-cycle-index)
                   (jaunte-cycle-reset symbol)))
        (list (symbol-value symbol)))
    (put symbol 'jaunte-cycle-index (1+ index))
    (nth (% index (length list)) list)))

(defvar jaunte--hints nil)

(defvar jaunte-hint-unit 'word
  "Hint unit. You can set this parameter same as `thing-at-point'.")
(make-variable-buffer-local 'jaunte-hint-unit)

(defun jaunte-forward-word ()
  "Move to beginning of a forward word, and return point."
  (interactive)
  (if (looking-at "\\w")
      (forward-thing jaunte-hint-unit))
  (if (re-search-forward "\\w" nil 'eob)
      (backward-char))
  (point))

(defun jaunte-make-hint (key overlay window point)
  (let ((hint (make-hash-table :test 'equal)))
    (puthash 'key key hint)
    (puthash 'overlay overlay hint)
    (puthash 'window window hint)
    (puthash 'point point hint)
    hint))

(defun jaunte-show-hints ()
  (condition-case err
      (let ((index 0))
        (jaunte-cycle-reset 'jaunte-hint-faces)
        (mapc
         (lambda (window)
           (save-excursion
             (save-window-excursion
               (select-window window)
               (move-to-window-line 0)
               (let ((point (if (looking-at "\\w")
                                (point)
                              (jaunte-forward-word)))
                     (window-end (window-end window))
                     (key (jaunte-make-key index)))
                 (while (< point window-end)
                   (add-to-list 'jaunte--hints
                                (jaunte-make-hint (jaunte-make-key index)
                                                  (jaunte-make-overlay point key)
                                                  window
                                                  point))
                   (jaunte-forward-word)
                   (setq index (1+ index)
                         point (point)
                         key (jaunte-make-key index)))))))
         (window-list)))
    (error
     (jaunte-remove-hints)
     (error (error-message-string err)))))

(defun jaunte-hint-match (key hint &optional perfect-match)
  (let ((hint-key (gethash 'key hint)))
    (if perfect-match
        (string= key hint-key)
      (equal 0 (string-match key hint-key)))))

(defun jaunte-search (key &optional perfect-match)
  (let (result)
    (mapc
     (lambda (hint)
       (if (jaunte-hint-match key hint perfect-match)
           (add-to-list 'result hint)
         (delete-overlay (gethash 'overlay hint))))
     jaunte--hints)
    (setq jaunte--hints result)))

(defun jaunte-remove-hints ()
  (jaunte-delete-overlays)
  (setq jaunte--hints nil))

(defun jaunte-delete-overlays ()
  (mapc
   (lambda (hint)
     (delete-overlay (gethash 'overlay hint)))
   jaunte--hints))

(defun jaunte-make-overlay (point key)
  (save-excursion
    (goto-char point)
    (let* ((width (length key))
           (rest width)
           (begin point)
           overlay)
      (while (and (> rest 0) (not (eolp)))
        (setq rest (- rest (char-width (char-after))))
        (forward-char))

      (if (and (eq (logand width 1) 1)
               (= 2 (char-width (char-before))))
          (setq key (concat key " ")))

      (setq overlay (make-overlay begin (point)))
      (overlay-put overlay 'display (propertize key 'face (jaunte-cycle 'jaunte-hint-faces)))
      (overlay-put overlay 'window (selected-window))
      (overlay-put overlay 'priority 100)
      overlay)))

(defun jaunte-make-key (index)
  (let* ((key-length (length jaunte-keys))
         (excess (/ index key-length))
         prefix
         (n (% index key-length)))
    (setq prefix (if (zerop excess)
                          "" (jaunte-make-key (1- excess))))
    (concat prefix (char-to-string (nth n jaunte-keys)))))

(defun jaunte-to (hint)
  (select-window (gethash 'window hint))
  (goto-char (gethash 'point hint)))

(defun jaunte ()
  (interactive)
  (jaunte-show-hints)
  (unwind-protect
      (let (k key)
        (while (not (null jaunte--hints))
          (setq k (read-event (concat "Jaunte to " key)))
          (if (and (not (null key))
                   (or (equal k 13) ;; C-m
                       (equal k 10) ;; C-j
                       (equal k 'return))) ;; RET
              (jaunte-search key t)
            (setq key (concat key (char-to-string k)))
            (jaunte-search key))
          (if (= 1 (length jaunte--hints))
              (progn (jaunte-to (car jaunte--hints)) (jaunte-remove-hints)))))
    (jaunte-remove-hints)))

(provide 'jaunte)
;;; jaunte.el ends here
Something went wrong with that request. Please try again.