+++ /dev/null
-;;; ace-jump-mode.el --- a quick cursor location minor mode for emacs -*- coding: utf-8-unix -*-
-
-;; Copyright (C) 2012 Free Software Foundation, Inc.
-
-;; Author : winterTTr <winterTTrNOSPAMgmail.com>
-;; URL : https://github.com/winterTTr/ace-jump-mode/
-;; Version : 2.0.RC
-;; Keywords : motion, location, cursor
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; INTRODUCTION
-;;
-
-;; What's this?
-;;
-;; It is a minor mode for Emacs. It can help you to move your cursor
-;; to ANY position in emacs by using only 3 times key press.
-
-;; Where does ace jump mode come from ?
-;;
-;; I firstly see such kind of moving style is in a vim plugin called
-;; EasyMotion. It really attract me a lot. So I decide to write
-;; one for Emacs and MAKE IT BETTER.
-;;
-;; So I want to thank to :
-;; Bartlomiej P. for his PreciseJump
-;; Kim Silkebækken for his EasyMotion
-
-
-;; What's ace-jump-mode ?
-;;
-;; ace-jump-mode is an fast/direct cursor location minor mode. It will
-;; create the N-Branch search tree internal and marks all the possible
-;; position with predefined keys in within the whole emacs view.
-;; Allowing you to move to the character/word/line almost directly.
-;;
-
-;;; Usage
-;;
-;; Add the following code to your init file, of course you can select
-;; the key that you prefer to.
-;; ----------------------------------------------------------
-;; ;;
-;; ;; ace jump mode major function
-;; ;;
-;; (add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/")
-;; (autoload
-;; 'ace-jump-mode
-;; "ace-jump-mode"
-;; "Emacs quick move minor mode"
-;; t)
-;; ;; you can select the key you prefer to
-;; (define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
-;;
-;; ;;
-;; ;; enable a more powerful jump back function from ace jump mode
-;; ;;
-;; (autoload
-;; 'ace-jump-mode-pop-mark
-;; "ace-jump-mode"
-;; "Ace jump back:-)"
-;; t)
-;; (eval-after-load "ace-jump-mode"
-;; '(ace-jump-mode-enable-mark-sync))
-;; (define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark)
-;;
-;; ;;If you use viper mode :
-;; (define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode)
-;; ;;If you use evil
-;; (define-key evil-normal-state-map (kbd "SPC") 'ace-jump-mode)
-;; ----------------------------------------------------------
-
-;;; For more information
-;; Intro Doc: https://github.com/winterTTr/ace-jump-mode/wiki
-;; FAQ : https://github.com/winterTTr/ace-jump-mode/wiki/AceJump-FAQ
-
-;;; Code:
-
-(require 'cl)
-
-;;;; ============================================
-;;;; Utilities for ace-jump-mode
-;;;; ============================================
-
-;; ---------------------
-;; aj-position
-;; ---------------------
-
-;; make a position in a visual area
-(defstruct aj-position offset visual-area)
-
-(defmacro aj-position-buffer (aj-pos)
- "Get the buffer object from `aj-position'."
- `(aj-visual-area-buffer (aj-position-visual-area ,aj-pos)))
-
-(defmacro aj-position-window (aj-pos)
- "Get the window object from `aj-position'."
- `(aj-visual-area-window (aj-position-visual-area ,aj-pos)))
-
-(defmacro aj-position-frame (aj-pos)
- "Get the frame object from `aj-position'."
- `(aj-visual-area-frame (aj-position-visual-area ,aj-pos)))
-
-(defmacro aj-position-recover-buffer (aj-pos)
- "Get the recover-buffer object from `aj-position'."
- `(aj-visual-area-recover-buffer (aj-position-visual-area ,aj-pos)))
-
-
-
-;; ---------------------
-;; aj-visual-area
-;; ---------------------
-
-;; a record for all the possible visual area
-;; a visual area is a window that showing some buffer in some frame.
-(defstruct aj-visual-area buffer window frame recover-buffer)
-
-
-;; ---------------------
-;; a FIFO queue implementation
-;; ---------------------
-(defstruct aj-queue head tail)
-
-(defun aj-queue-push (item q)
- "enqueue"
- (let ( (head (aj-queue-head q) )
- (tail (aj-queue-tail q) )
- (c (list item) ) )
- (cond
- ((null (aj-queue-head q))
- (setf (aj-queue-head q) c)
- (setf (aj-queue-tail q) c))
- (t
- (setf (cdr (aj-queue-tail q)) c)
- (setf (aj-queue-tail q) c)))))
-
-(defun aj-queue-pop (q)
- "dequeue"
- (if (null (aj-queue-head q))
- (error "[AceJump] Interal Error: Empty queue"))
-
- (let ((ret (aj-queue-head q)))
- (if (eq ret (aj-queue-tail q))
- ;; only one item left
- (progn
- (setf (aj-queue-head q) nil)
- (setf (aj-queue-tail q) nil))
- ;; multi item left, move forward the head
- (setf (aj-queue-head q) (cdr ret)))
- (car ret)))
-
-
-
-;;; main code start here
-
-;; register as a minor mode
-(or (assq 'ace-jump-mode minor-mode-alist)
- (nconc minor-mode-alist
- (list '(ace-jump-mode ace-jump-mode))))
-
-;; custoize variable
-(defvar ace-jump-word-mode-use-query-char t
- "If we need to ask for the query char before enter `ace-jump-word-mode'")
-
-(defvar ace-jump-mode-case-fold case-fold-search
- "If non-nil, the ace-jump mode will ignore case.
-
-The default value is set to the same as `case-fold-search'.")
-
-(defvar ace-jump-mode-mark-ring nil
- "The list that is used to store the history for jump back.")
-
-(defvar ace-jump-mode-mark-ring-max 100
- "The max length of `ace-jump-mode-mark-ring'")
-
-
-(defvar ace-jump-mode-gray-background t
- "By default, when there is more than one candidate, the ace
-jump mode will gray the background and then mark the possible
-candidate position. Set this to nil means do not gray
-background.")
-
-(defvar ace-jump-mode-scope 'global
- "Define what is the scope that ace-jump-mode works.
-
-Now, there three kind of values for this:
-1. 'global : ace jump can work across any window and frame, this is also the default.
-2. 'frame : ace jump will work for the all windows in current frame.
-3. 'window : ace jump will only work on current window only.
- This is the same behavior for 1.0 version.")
-
-(defvar ace-jump-mode-detect-punc t
- "When this is non-nil, the ace jump word mode will detect the
-char that is not alpha or number. Then, if the query char is a
-printable punctuaction, we will use char mode to start the ace
-jump mode. If it is nil, an error will come up when
-non-alpha-number is given under word mode.")
-
-
-(defvar ace-jump-mode-submode-list
- '(ace-jump-word-mode
- ace-jump-char-mode
- ace-jump-line-mode)
- "*The mode list when start ace jump mode.
-The sequence is the calling sequence when give prefix argument.
-
-Such as:
- If you use the default sequence, which is
- '(ace-jump-word-mode
- ace-jump-char-mode
- ace-jump-line-mode)
-and using key to start up ace jump mode, such as 'C-c SPC',
-then the usage to start each mode is as below:
-
- C-c SPC ==> ace-jump-word-mode
- C-u C-c SPC ==> ace-jump-char-mode
- C-u C-u C-c SPC ==> ace-jump-line-mode
-
-Currently, the valid submode is:
- `ace-jump-word-mode'
- `ace-jump-char-mode'
- `ace-jump-line-mode'
-
-")
-
-(defvar ace-jump-mode-move-keys
- (nconc (loop for i from ?a to ?z collect i)
- (loop for i from ?A to ?Z collect i))
- "*The keys that used to move when enter AceJump mode.
-Each key should only an printable character, whose name will
-fill each possible location.
-
-If you want your own moving keys, you can custom that as follow,
-for example, you only want to use lower case character:
-\(setq ace-jump-mode-move-keys (loop for i from ?a to ?z collect i)) ")
-
-
-;;; some internal variable for ace jump
-(defvar ace-jump-mode nil
- "AceJump minor mode.")
-(defvar ace-jump-background-overlay-list nil
- "Background overlay which will grey all the display.")
-(defvar ace-jump-search-tree nil
- "N-branch Search tree. Every leaf node holds the overlay that
-is used to highlight the target positions.")
-(defvar ace-jump-query-char nil
- "Save the query char used between internal mode.")
-(defvar ace-jump-current-mode nil
- "Save the current mode.
-See `ace-jump-mode-submode-list' for possible value.")
-
-(defvar ace-jump-recover-visual-area-list nil
- "Save the ace jump aj-visual-area structure list.
-
-Sometimes, the different window may display the same buffer. For
-this case, we need to create a indirect buffer for them to make
-ace jump overlay can work across the differnt window with the
-same buffer. When ace jump ends, we need to recover the window to
-its original buffer.")
-(defvar ace-jump-sync-emacs-mark-ring nil
- "When this variable is not-nil, everytime `ace-jump-mode-pop-mark' is called,
-ace jump will try to remove the same mark from buffer local mark
-ring and global-mark-ring, which help you to sync the mark
-information between emacs and ace jump.
-
-Note, never try to set this variable manually, this is for ace
-jump internal use. If you want to change it, use
-`ace-jump-mode-enable-mark-sync' or
-`ace-jump-mode-disable-mark-sync'.")
-
-(defgroup ace-jump nil
- "ace jump group"
- :group 'convenience)
-
-;;; define the face
-(defface ace-jump-face-background
- '((t (:foreground "gray40")))
- "Face for background of AceJump motion"
- :group 'ace-jump)
-
-
-(defface ace-jump-face-foreground
- '((((class color)) (:foreground "red"))
- (((background dark)) (:foreground "gray100"))
- (((background light)) (:foreground "gray0"))
- (t (:foreground "gray100")))
- "Face for foreground of AceJump motion"
- :group 'ace-jump)
-
-
-(defvar ace-jump-mode-before-jump-hook nil
- "Function(s) to call just before moving the cursor to a selected match")
-
-(defvar ace-jump-mode-end-hook nil
- "Function(s) to call when ace-jump-mode is going to end up")
-
-(defvar ace-jump-allow-invisible nil
- "Control if ace-jump should select the invisible char as candidate.
-Normally, the ace jump mark cannot be seen if the target character is invisible.
-So default to be nil, which will not include those invisible character as candidate.")
-
-
-(defun ace-jump-char-category ( query-char )
- "Detect the type of the char.
-For the ascii table, refer to http://www.asciitable.com/
-
-There is four possible return value:
-1. 'digit: the number character
-2. 'alpha: A-Z and a-z
-3. 'punc : all the printable punctuaiton
-4. 'other: all the others"
- (cond
- ;; digit
- ((and (>= query-char #x30) (<= query-char #x39))
- 'digit)
- ((or
- ;; capital letter
- (and (>= query-char #x41) (<= query-char #x5A))
- ;; lowercase letter
- (and (>= query-char #x61) (<= query-char #x7A)))
- 'alpha)
- ((or
- ;; tab
- (equal query-char #x9)
- ;; punc before digit
- (and (>= query-char #x20) (<= query-char #x2F))
- ;; punc after digit before capital letter
- (and (>= query-char #x3A) (<= query-char #x40))
- ;; punc after capital letter before lowercase letter
- (and (>= query-char #x5B) (<= query-char #x60))
- ;; punc after lowercase letter
- (and (>= query-char #x7B) (<= query-char #x7E)))
- 'punc)
- (t
- 'other)))
-
-
-(defun ace-jump-search-candidate (re-query-string visual-area-list)
- "Search the RE-QUERY-STRING in current view, and return the candidate position list.
-RE-QUERY-STRING should be an valid regex used for `search-forward-regexp'.
-
-You can control whether use the case sensitive or not by `ace-jump-mode-case-fold'.
-
-Every possible `match-beginning' will be collected.
-The returned value is a list of `aj-position' record."
- (loop for va in visual-area-list
- append (let* ((current-window (aj-visual-area-window va))
- (start-point (window-start current-window))
- (end-point (window-end current-window t)))
- (with-selected-window current-window
- (save-excursion
- (goto-char start-point)
- (let ((case-fold-search ace-jump-mode-case-fold))
- (loop while (re-search-forward re-query-string nil t)
- until (or
- (> (point) end-point)
- (eobp))
- if (or ace-jump-allow-invisible (not (invisible-p (match-beginning 0))))
- collect (make-aj-position :offset (match-beginning 0)
- :visual-area va)
- ;; when we use "^" to search line mode,
- ;; re-search-backward will not move one
- ;; char after search success, as line
- ;; begin is not a valid visible char.
- ;; We need to help it to move forward.
- do (if (string-equal re-query-string "^")
- (goto-char (1+ (match-beginning 0)))))))))))
-
-(defun ace-jump-tree-breadth-first-construct (total-leaf-node max-child-node)
- "Constrct the search tree, each item in the tree is a cons cell.
-The (car tree-node) is the type, which should be only 'branch or 'leaf.
-The (cdr tree-node) is data stored in a leaf when type is 'leaf,
-while a child node list when type is 'branch"
- (let ((left-leaf-node (- total-leaf-node 1))
- (q (make-aj-queue))
- (node nil)
- (root (cons 'leaf nil)) )
- ;; we push the node into queue and make candidate-sum -1, so
- ;; create the start condition for the while loop
- (aj-queue-push root q)
- (while (> left-leaf-node 0)
- (setq node (aj-queue-pop q))
- ;; when a node is picked up from stack, it will be changed to a
- ;; branch node, we lose a leaft node
- (setf (car node) 'branch)
- ;; so we need to add the sum of leaf nodes that we wish to create
- (setq left-leaf-node (1+ left-leaf-node))
- (if (<= left-leaf-node max-child-node)
- ;; current child can fill the left leaf
- (progn
- (setf (cdr node)
- (loop for i from 1 to left-leaf-node
- collect (cons 'leaf nil)))
- ;; so this should be the last action for while
- (setq left-leaf-node 0))
- ;; the child can not cover the left leaf
- (progn
- ;; fill as much as possible. Push them to queue, so it have
- ;; the oppotunity to become 'branch node if necessary
- (setf (cdr node)
- (loop for i from 1 to max-child-node
- collect (let ((n (cons 'leaf nil)))
- (aj-queue-push n q)
- n)))
- (setq left-leaf-node (- left-leaf-node max-child-node)))))
- ;; return the root node
- root))
-
-(defun ace-jump-tree-preorder-traverse (tree &optional leaf-func branch-func)
- "we move over tree via preorder, and call BRANCH-FUNC on each branch
-node and call LEAF-FUNC on each leaf node"
- ;; use stack to do preorder traverse
- (let ((s (list tree)))
- (while (not (null s))
- ;; pick up one from stack
- (let ((node (car s)))
- ;; update stack
- (setq s (cdr s))
- (cond
- ((eq (car node) 'branch)
- ;; a branch node
- (when branch-func
- (funcall branch-func node))
- ;; push all child node into stack
- (setq s (append (cdr node) s)))
- ((eq (car node) 'leaf)
- (when leaf-func
- (funcall leaf-func node)))
- (t
- (message "[AceJump] Internal Error: invalid tree node type")))))))
-
-
-(defun ace-jump-populate-overlay-to-search-tree (tree candidate-list)
- "Populate the overlay to search tree, every leaf will give one overlay"
-
- (lexical-let* (;; create the locally dynamic variable for the following function
- (position-list candidate-list)
-
- ;; make the function to create overlay for each leaf node,
- ;; here we only create each overlay for each candidate
- ;; position, , but leave the 'display property to be empty,
- ;; which will be fill in "update-overlay" function
- (func-create-overlay (lambda (node)
- (let* ((p (car position-list))
- (offset (aj-position-offset p))
- (va (aj-position-visual-area p))
- (w (aj-visual-area-window va))
- (b (aj-visual-area-buffer va))
- ;; create one char overlay
- (ol (make-overlay offset (1+ offset) b)))
- ;; update leaf node to remember the ol
- (setf (cdr node) ol)
- (overlay-put ol 'face 'ace-jump-face-foreground)
- ;; associate the aj-position data with overlay
- ;; so that we can use it to do the final jump
- (overlay-put ol 'aj-data p)
- ;; next candidate node
- (setq position-list (cdr position-list))))))
- (ace-jump-tree-preorder-traverse tree func-create-overlay)
- tree))
-
-
-(defun ace-jump-delete-overlay-in-search-tree (tree)
- "Delete all the overlay in search tree leaf node"
- (let ((func-delete-overlay (lambda (node)
- (delete-overlay (cdr node))
- (setf (cdr node) nil))))
- (ace-jump-tree-preorder-traverse tree func-delete-overlay)))
-
-(defun ace-jump-buffer-substring (pos)
- "Get the char under the POS, which is aj-position structure."
- (let* ((w (aj-position-window pos))
- (offset (aj-position-offset pos)))
- (with-selected-window w
- (buffer-substring offset (1+ offset)))))
-
-(defun ace-jump-update-overlay-in-search-tree (tree keys)
- "Update overlay 'display property using each name in keys"
- (lexical-let* (;; create dynamic variable for following function
- (key ?\0)
- ;; populdate each leaf node to be the specific key,
- ;; this only update 'display' property of overlay,
- ;; so that user can see the key from screen and select
- (func-update-overlay
- (lambda (node)
- (let ((ol (cdr node)))
- (overlay-put
- ol
- 'display
- (concat (make-string 1 key)
- (let* ((pos (overlay-get ol 'aj-data))
- (subs (ace-jump-buffer-substring pos)))
- (cond
- ;; when tab, we use more space to prevent screen
- ;; from messing up
- ((string-equal subs "\t")
- (make-string (1- tab-width) ? ))
- ;; when enter, we need to add one more enter
- ;; to make the screen not change
- ((string-equal subs "\n")
- "\n")
- (t
- "")))))))))
- (loop for k in keys
- for n in (cdr tree)
- do (progn
- ;; update "key" variable so that the function can use
- ;; the correct context
- (setq key k)
- (if (eq (car n) 'branch)
- (ace-jump-tree-preorder-traverse n
- func-update-overlay)
- (funcall func-update-overlay n))))))
-
-
-
-(defun ace-jump-list-visual-area()
- "Based on `ace-jump-mode-scope', search the possible buffers that is showing now."
- (cond
- ((eq ace-jump-mode-scope 'global)
- (loop for f in (frame-list)
- append (loop for w in (window-list f)
- collect (make-aj-visual-area :buffer (window-buffer w)
- :window w
- :frame f))))
- ((eq ace-jump-mode-scope 'frame)
- (loop for w in (window-list (selected-frame))
- collect (make-aj-visual-area :buffer (window-buffer w)
- :window w
- :frame (selected-frame))))
- ((eq ace-jump-mode-scope 'window)
- (list
- (make-aj-visual-area :buffer (current-buffer)
- :window (selected-window)
- :frame (selected-frame))))
- (t
- (error "[AceJump] Invalid ace-jump-mode-scope, please check your configuration"))))
-
-
-(defun ace-jump-mode-make-indirect-buffer (visual-area-list)
- "When the differnt window show the same buffer. The overlay
-cannot work for same buffer at the same time. So the indirect
-buffer need to create to make overlay can work correctly.
-
-VISUAL-AREA-LIST is aj-visual-area list. This function will
-return the structure list for those make a indirect buffer.
-
-Side affect: All the created indirect buffer will show in its
-relevant window."
- (loop for va in visual-area-list
- ;; check if the current visual-area (va) has the same buffer with
- ;; the previous ones (vai)
- if (loop for vai in visual-area-list
- ;; stop at itself, don't need to find the ones behind it (va)
- until (eq vai va)
- ;; if the buffer is same, return those(vai) before
- ;; it(va) so that we know the some visual area has
- ;; the same buffer with current one (va)
- if (eq (aj-visual-area-buffer va)
- (aj-visual-area-buffer vai))
- collect vai)
- ;; if indeed the same one find, we need create an indirect buffer
- ;; to current visual area(va)
- collect (with-selected-window (aj-visual-area-window va)
- ;; store the orignal buffer
- (setf (aj-visual-area-recover-buffer va)
- (aj-visual-area-buffer va))
- ;; create indirect buffer to use as working buffer
- (setf (aj-visual-area-buffer va)
- (clone-indirect-buffer nil nil))
- ;; update window to the indirect buffer
- (let ((ws (window-start)))
- (set-window-buffer (aj-visual-area-window va)
- (aj-visual-area-buffer va))
- (set-window-start
- (aj-visual-area-window va)
- ws))
- va)))
-
-
-(defun ace-jump-do( re-query-string )
- "The main function to start the AceJump mode.
-QUERY-STRING should be a valid regexp string, which finally pass to `search-forward-regexp'.
-
-You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
-"
- ;; we check the move key to make it valid, cause it can be customized by user
- (if (or (null ace-jump-mode-move-keys)
- (< (length ace-jump-mode-move-keys) 2)
- (not (every #'characterp ace-jump-mode-move-keys)))
- (error "[AceJump] Invalid move keys: check ace-jump-mode-move-keys"))
- ;; search candidate position
- (let* ((visual-area-list (ace-jump-list-visual-area))
- (candidate-list (ace-jump-search-candidate re-query-string visual-area-list)))
- (cond
- ;; cannot find any one
- ((null candidate-list)
- (setq ace-jump-current-mode nil)
- (error "[AceJump] No one found"))
- ;; we only find one, so move to it directly
- ((eq (cdr candidate-list) nil)
- (ace-jump-push-mark)
- (run-hooks 'ace-jump-mode-before-jump-hook)
- (ace-jump-jump-to (car candidate-list))
- (message "[AceJump] One candidate, move to it directly")
- (run-hooks 'ace-jump-mode-end-hook))
- ;; more than one, we need to enter AceJump mode
- (t
- ;; make indirect buffer for those windows that show the same buffer
- (setq ace-jump-recover-visual-area-list
- (ace-jump-mode-make-indirect-buffer visual-area-list))
- ;; create background for each visual area
- (if ace-jump-mode-gray-background
- (setq ace-jump-background-overlay-list
- (loop for va in visual-area-list
- collect (let* ((w (aj-visual-area-window va))
- (b (aj-visual-area-buffer va))
- (ol (make-overlay (window-start w)
- (window-end w)
- b)))
- (overlay-put ol 'face 'ace-jump-face-background)
- ol))))
-
- ;; construct search tree and populate overlay into tree
- (setq ace-jump-search-tree
- (ace-jump-tree-breadth-first-construct (length candidate-list)
- (length ace-jump-mode-move-keys)))
- (ace-jump-populate-overlay-to-search-tree ace-jump-search-tree
- candidate-list)
- (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
- ace-jump-mode-move-keys)
-
- ;; do minor mode configuration
- (cond
- ((eq ace-jump-current-mode 'ace-jump-char-mode)
- (setq ace-jump-mode " AceJump - Char"))
- ((eq ace-jump-current-mode 'ace-jump-word-mode)
- (setq ace-jump-mode " AceJump - Word"))
- ((eq ace-jump-current-mode 'ace-jump-line-mode)
- (setq ace-jump-mode " AceJump - Line"))
- (t
- (setq ace-jump-mode " AceJump")))
- (force-mode-line-update)
-
-
- ;; override the local key map
- (setq overriding-local-map
- (let ( (map (make-keymap)) )
- (dolist (key-code ace-jump-mode-move-keys)
- (define-key map (make-string 1 key-code) 'ace-jump-move))
- (define-key map (kbd "C-c C-c") 'ace-jump-quick-exchange)
- (define-key map [t] 'ace-jump-done)
- map))
-
- (add-hook 'mouse-leave-buffer-hook 'ace-jump-done)
- (add-hook 'kbd-macro-termination-hook 'ace-jump-done)))))
-
-
-(defun ace-jump-jump-to (position)
- "Jump to the POSITION, which is a `aj-position' structure storing the position information"
- (let ((offset (aj-position-offset position))
- (frame (aj-position-frame position))
- (window (aj-position-window position))
- (buffer (aj-position-buffer position)))
- ;; focus to the frame
- (if (and (frame-live-p frame)
- (not (eq frame (selected-frame))))
- (select-frame-set-input-focus (window-frame window)))
-
- ;; select the correct window
- (if (and (window-live-p window)
- (not (eq window (selected-window))))
- (select-window window))
-
- ;; swith to buffer
- (if (and (buffer-live-p buffer)
- (not (eq buffer (window-buffer window))))
- (switch-to-buffer buffer))
- ;; move to correct position
-
- (if (and (buffer-live-p buffer)
- (eq (current-buffer) buffer))
- (goto-char offset))))
-
-(defun ace-jump-push-mark ()
- "Push the current position information onto the `ace-jump-mode-mark-ring'."
- ;; add mark to the emacs basic push mark
- (push-mark (point) t)
- ;; we also push the mark on the `ace-jump-mode-mark-ring', which has
- ;; more information for better jump back
- (let ((pos (make-aj-position :offset (point)
- :visual-area (make-aj-visual-area :buffer (current-buffer)
- :window (selected-window)
- :frame (selected-frame)))))
- (setq ace-jump-mode-mark-ring (cons pos ace-jump-mode-mark-ring)))
- ;; when exeed the max count, discard the last one
- (if (> (length ace-jump-mode-mark-ring) ace-jump-mode-mark-ring-max)
- (setcdr (nthcdr (1- ace-jump-mode-mark-ring-max) ace-jump-mode-mark-ring) nil)))
-
-
-;;;###autoload
-(defun ace-jump-mode-pop-mark ()
- "Pop up a postion from `ace-jump-mode-mark-ring', and jump back to that position"
- (interactive)
- ;; we jump over the killed buffer position
- (while (and ace-jump-mode-mark-ring
- (not (buffer-live-p (aj-position-buffer
- (car ace-jump-mode-mark-ring)))))
- (setq ace-jump-mode-mark-ring (cdr ace-jump-mode-mark-ring)))
-
- (if (null ace-jump-mode-mark-ring)
- ;; no valid history exist
- (error "[AceJump] No more history"))
-
- (if ace-jump-sync-emacs-mark-ring
- (let ((p (car ace-jump-mode-mark-ring)))
- ;; if we are jump back in the current buffer, that means we
- ;; only need to sync the buffer local mark-ring
- (if (eq (current-buffer) (aj-position-buffer p))
- (if (equal (aj-position-offset p) (marker-position (mark-marker)))
- ;; if the current marker is the same as where we need
- ;; to jump back, we do the same as pop-mark actually,
- ;; copy implementation from pop-mark, cannot use it
- ;; directly, as there is advice on it
- (when mark-ring
- (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
- (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
- (move-marker (car mark-ring) nil)
- (setq mark-ring (cdr mark-ring))
- (deactivate-mark))
-
- ;; But if there is other marker put before the wanted destination, the following scenario
- ;;
- ;; +---+---+---+---+ +---+---+---+---+
- ;; Mark Ring | 2 | 3 | 4 | 5 | | 2 | 4 | 5 | 3 |
- ;; +---+---+---+---+ +---+---+---+---+
- ;; +---+ +---+
- ;; Marker | 1 | | 1 | <-- Maker (not changed)
- ;; +---+ +---+
- ;; +---+ +---+
- ;; Cursor | X | Pop up AJ mark 3 | 3 | <-- Cursor position
- ;; +---+ +---+
- ;; +---+---+---+ +---+---+---+
- ;; AJ Ring | 3 | 4 | 5 | | 4 | 5 | 3 |
- ;; +---+---+---+ +---+---+---+
- ;;
- ;; So what we need to do, is put the found mark in mark-ring to the end
- (lexical-let ((po (aj-position-offset p)))
- (setq mark-ring
- (ace-jump-move-first-to-end-if mark-ring
- (lambda (x)
- (equal (marker-position x) po))))))
-
-
- ;; when we jump back to another buffer, do as the
- ;; pop-global-mark does. But we move the marker with the
- ;; same target buffer to the end, not always the first one
- (lexical-let ((pb (aj-position-buffer p)))
- (setq global-mark-ring
- (ace-jump-move-first-to-end-if global-mark-ring
- (lambda (x)
- (eq (marker-buffer x) pb))))))))
-
-
- ;; move the first element to the end of the ring
- (ace-jump-jump-to (car ace-jump-mode-mark-ring))
- (setq ace-jump-mode-mark-ring (nconc (cdr ace-jump-mode-mark-ring)
- (list (car ace-jump-mode-mark-ring)))))
-
-(defun ace-jump-quick-exchange ()
- "The function that we can use to quick exhange the current mode between
-word-mode and char-mode"
- (interactive)
- (cond
- ((eq ace-jump-current-mode 'ace-jump-char-mode)
- (if ace-jump-query-char
- ;; ace-jump-done will clean the query char, so we need to save it
- (let ((query-char ace-jump-query-char))
- (ace-jump-done)
- (ace-jump-word-mode query-char))))
- ((eq ace-jump-current-mode 'ace-jump-word-mode)
- (if ace-jump-query-char
- ;; ace-jump-done will clean the query char, so we need to save it
- (let ((query-char ace-jump-query-char))
- (ace-jump-done)
- ;; restore the flag
- (ace-jump-char-mode query-char))))
- ((eq ace-jump-current-mode 'ace-jump-line-mode)
- nil)
- (t
- nil)))
-
-
-
-
-;;;###autoload
-(defun ace-jump-char-mode (query-char)
- "AceJump char mode"
- (interactive (list (read-char "Query Char:")))
-
- ;; We should prevent recursion call this function. This can happen
- ;; when you trigger the key for ace jump again when already in ace
- ;; jump mode. So we stop the previous one first.
- (if ace-jump-current-mode (ace-jump-done))
-
- (if (eq (ace-jump-char-category query-char) 'other)
- (error "[AceJump] Non-printable character"))
-
- ;; others : digit , alpha, punc
- (setq ace-jump-query-char query-char)
- (setq ace-jump-current-mode 'ace-jump-char-mode)
- (ace-jump-do (regexp-quote (make-string 1 query-char))))
-
-
-;;;###autoload
-(defun ace-jump-word-mode (head-char)
- "AceJump word mode.
-You can set `ace-jump-word-mode-use-query-char' to nil to prevent
-asking for a head char, that will mark all the word in current
-buffer."
- (interactive (list (if ace-jump-word-mode-use-query-char
- (read-char "Head Char:")
- nil)))
-
- ;; We should prevent recursion call this function. This can happen
- ;; when you trigger the key for ace jump again when already in ace
- ;; jump mode. So we stop the previous one first.
- (if ace-jump-current-mode (ace-jump-done))
-
- (cond
- ((null head-char)
- ;; \< - start of word
- ;; \sw - word constituent
- (ace-jump-do "\\<\\sw"))
- ((memq (ace-jump-char-category head-char)
- '(digit alpha))
- (setq ace-jump-query-char head-char)
- (setq ace-jump-current-mode 'ace-jump-word-mode)
- (ace-jump-do (concat "\\<" (make-string 1 head-char))))
- ((eq (ace-jump-char-category head-char)
- 'punc)
- ;; we do not query punctuation under word mode
- (if (null ace-jump-mode-detect-punc)
- (error "[AceJump] Not a valid word constituent"))
- ;; we will use char mode to continue search
- (setq ace-jump-query-char head-char)
- (setq ace-jump-current-mode 'ace-jump-char-mode)
- (ace-jump-do (regexp-quote (make-string 1 head-char))))
- (t
- (error "[AceJump] Non-printable character"))))
-
-
-;;;###autoload
-(defun ace-jump-line-mode ()
- "AceJump line mode.
-Marked each no empty line and move there"
- (interactive)
-
- ;; We should prevent recursion call this function. This can happen
- ;; when you trigger the key for ace jump again when already in ace
- ;; jump mode. So we stop the previous one first.
- (if ace-jump-current-mode (ace-jump-done))
-
- (setq ace-jump-current-mode 'ace-jump-line-mode)
- (ace-jump-do "^"))
-
-;;;###autoload
-(defun ace-jump-mode(&optional prefix)
- "AceJump mode is a minor mode for you to quick jump to a
-position in the curret view.
- There is three submode now:
- `ace-jump-char-mode'
- `ace-jump-word-mode'
- `ace-jump-line-mode'
-
-You can specify the sequence about which mode should enter
-by customize `ace-jump-mode-submode-list'.
-
-If you do not want to query char for word mode, you can change
-`ace-jump-word-mode-use-query-char' to nil.
-
-If you don't like the default move keys, you can change it by
-setting `ace-jump-mode-move-keys'.
-
-You can constrol whether use the case sensitive via
-`ace-jump-mode-case-fold'.
-"
- (interactive "p")
- (let ((index (/ prefix 4))
- (submode-list-length (length ace-jump-mode-submode-list)))
- (if (< index 0)
- (error "[AceJump] Invalid prefix command"))
- (if (>= index submode-list-length)
- (setq index (1- submode-list-length)))
- (call-interactively (nth index ace-jump-mode-submode-list))))
-
-(defun ace-jump-move ()
- "move cursor based on user input"
- (interactive)
- (let* ((index (let ((ret (position (aref (this-command-keys) 0)
- ace-jump-mode-move-keys)))
- (if ret ret (length ace-jump-mode-move-keys))))
- (node (nth index (cdr ace-jump-search-tree))))
- (cond
- ;; we do not find key in search tree. This can happen, for
- ;; example, when there is only three selections in screen
- ;; (totally five move-keys), but user press the forth move key
- ((null node)
- (message "No such position candidate.")
- (ace-jump-done))
- ;; this is a branch node, which means there need further
- ;; selection
- ((eq (car node) 'branch)
- (let ((old-tree ace-jump-search-tree))
- ;; we use sub tree in next move, create a new root node
- ;; whose child is the sub tree nodes
- (setq ace-jump-search-tree (cons 'branch (cdr node)))
- (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
- ace-jump-mode-move-keys)
-
- ;; this is important, we need remove the subtree first before
- ;; do delete, we set the child nodes to nil
- (setf (cdr node) nil)
- (ace-jump-delete-overlay-in-search-tree old-tree)))
- ;; if the node is leaf node, this is the final one
- ((eq (car node) 'leaf)
- ;; need to save aj data, as `ace-jump-done' will clean it
- (let ((aj-data (overlay-get (cdr node) 'aj-data)))
- (ace-jump-done)
- (ace-jump-push-mark)
- (run-hooks 'ace-jump-mode-before-jump-hook)
- (ace-jump-jump-to aj-data))
- (run-hooks 'ace-jump-mode-end-hook))
- (t
- (ace-jump-done)
- (error "[AceJump] Internal error: tree node type is invalid")))))
-
-
-
-(defun ace-jump-done()
- "stop AceJump motion"
- (interactive)
- ;; clear the status flag
- (setq ace-jump-query-char nil)
- (setq ace-jump-current-mode nil)
-
- ;; clean the status line
- (setq ace-jump-mode nil)
- (force-mode-line-update)
-
- ;; delete background overlay
- (loop for ol in ace-jump-background-overlay-list
- do (delete-overlay ol))
- (setq ace-jump-background-overlay-list nil)
-
-
- ;; we clean the indirect buffer
- (loop for va in ace-jump-recover-visual-area-list
- do (with-selected-window (aj-visual-area-window va)
- (let ((fake-buffer (aj-visual-area-buffer va))
- (original-buffer (aj-visual-area-recover-buffer va)))
- ;; recover display buffer
- (set-window-buffer (aj-visual-area-window va)
- original-buffer)
- ;; update visual area, which we need to use it to do the
- ;; final jump, and as well, save in history
- (setf (aj-visual-area-buffer va) original-buffer)
- (setf (aj-visual-area-recover-buffer va) nil)
- ;; kill indirect buffer
- (ace-jump-kill-buffer fake-buffer))))
-
- ;; delete overlays in search tree
- (ace-jump-delete-overlay-in-search-tree ace-jump-search-tree)
- (setq ace-jump-search-tree nil)
-
- (setq overriding-local-map nil)
-
- (remove-hook 'mouse-leave-buffer-hook 'ace-jump-done)
- (remove-hook 'kbd-macro-termination-hook 'ace-jump-done))
-
-(defun ace-jump-kill-buffer(buffer)
- "Utility function to kill buffer for ace jump mode.
-We also need to handle the buffer which has clients on it"
- (if (and (boundp 'server-buffer-clients)
- server-buffer-clients)
- (server-buffer-done buffer t))
- (kill-buffer buffer))
-
-;;;; ============================================
-;;;; advice to sync emacs mark ring
-;;;; ============================================
-
-(defun ace-jump-move-to-end-if ( l pred )
- "Move all the element in a list to the end of list if it make
-the PRED to return non-nil.
-
-PRED is a function object which can pass to funcall and accept
-one argument, which will be every element in the list.
-Such as : (lambda (x) (equal x 1)) "
- (let (true-list false-list)
- (loop for e in l
- do (if (funcall pred e)
- (setq true-list (cons e true-list))
- (setq false-list (cons e false-list))))
- (nconc (nreverse false-list)
- (and true-list (nreverse true-list)))))
-
-(defun ace-jump-move-first-to-end-if (l pred)
- "Only move the first found one to the end of list"
- (lexical-let ((pred pred)
- found)
- (ace-jump-move-to-end-if l
- (lambda (x)
- (if found
- nil
- (setq found (funcall pred x)))))))
-
-
-
-(defadvice pop-mark (before ace-jump-pop-mark-advice)
- "When `pop-mark' is called to jump back, this advice will sync the mark ring.
-Move the same position to the end of `ace-jump-mode-mark-ring'."
- (lexical-let ((mp (mark t))
- (cb (current-buffer)))
- (if mp
- (setq ace-jump-mode-mark-ring
- (ace-jump-move-first-to-end-if ace-jump-mode-mark-ring
- (lambda (x)
- (and (equal (aj-position-offset x) mp)
- (eq (aj-position-buffer x) cb))))))))
-
-
-(defadvice pop-global-mark (before ace-jump-pop-global-mark-advice)
- "When `pop-global-mark' is called to jump back, this advice will sync the mark ring.
-Move the aj-position with the same buffer to the end of `ace-jump-mode-mark-ring'."
- (interactive)
- ;; find the one that will be jump to
- (let ((index global-mark-ring))
- ;; refer to the implementation of `pop-global-mark'
- (while (and index (not (marker-buffer (car index))))
- (setq index (cdr index)))
- (if index
- ;; find the mark
- (lexical-let ((mb (marker-buffer (car index))))
- (setq ace-jump-mode-mark-ring
- (ace-jump-move-to-end-if ace-jump-mode-mark-ring
- (lambda (x)
- (eq (aj-position-buffer x) mb))))))))
-
-
-(defun ace-jump-mode-enable-mark-sync ()
- "Enable the sync funciton between ace jump mode mark ring and emacs mark ring.
-
-1. This function will enable the advice which activate on
-`pop-mark' and `pop-global-mark'. These advice will remove the
-same marker from `ace-jump-mode-mark-ring' when user use
-`pop-mark' or `global-pop-mark' to jump back.
-
-2. Set variable `ace-jump-sync-emacs-mark-ring' to t, which will
-sync mark information with emacs mark ring. "
- (ad-enable-advice 'pop-mark 'before 'ace-jump-pop-mark-advice)
- (ad-activate 'pop-mark)
- (ad-enable-advice 'pop-global-mark 'before 'ace-jump-pop-global-mark-advice)
- (ad-activate 'pop-global-mark)
- (setq ace-jump-sync-emacs-mark-ring t))
-
-(defun ace-jump-mode-disable-mark-sync ()
- "Disable the sync funciton between ace jump mode mark ring and emacs mark ring.
-
-1. This function will diable the advice which activate on
-`pop-mark' and `pop-global-mark'. These advice will remove the
-same marker from `ace-jump-mode-mark-ring' when user use
-`pop-mark' or `global-pop-mark' to jump back.
-
-2. Set variable `ace-jump-sync-emacs-mark-ring' to nil, which
-will stop synchronizing mark information with emacs mark ring. "
- (ad-disable-advice 'pop-mark 'before 'ace-jump-pop-mark-advice)
- (ad-activate 'pop-mark)
- (ad-disable-advice 'pop-global-mark 'before 'ace-jump-pop-global-mark-advice)
- (ad-activate 'pop-global-mark)
- (setq ace-jump-sync-emacs-mark-ring nil))
-
-
-(provide 'ace-jump-mode)
-
-;;; ace-jump-mode.el ends here
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
*** ace-jump-mode
#+BEGIN_SRC emacs-lisp
+ (add-to-list 'load-path "~/.emacs.d/elpa/ace-jump-mode-20140616.115")
(require 'ace-jump-mode)
(define-key global-map (kbd "C-c C-@") 'ace-jump-mode)
+++ /dev/null
-;;; centered-cursor-mode.el --- cursor stays vertically centered
-
-;; Copyright (C) 2007 André Riemann
-
-;; Author: André Riemann <andre.riemannNOSPAMweb.de>
-;; Maintainer: André Riemann <andre.riemannNOSPAMweb.de>
-;; Created: 2007-09-14
-;; Keywords: convenience
-
-;; URL: http://www.emacswiki.org/cgi-bin/wiki/centered-cursor-mode.el
-;; Compatibility: only tested with GNU Emacs 23.0
-;; Version: 0.5.2
-;; Last-Updated: 2009-08-31
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This file is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
-;; MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Makes the cursor stay vertically in a defined position (usually
-;; centered). The vertical position can be altered, see key definition
-;; below.
-
-;; To load put that in .emacs:
-;; (require 'centered-cursor-mode)
-;; To activate do:
-;; M-x centered-cursor-mode
-;; for buffer local or
-;; M-x global-centered-cursor-mode
-;; for global minor mode.
-;; Also possible: put that in .emacs
-;; (and
-;; (require 'centered-cursor-mode)
-;; (global-centered-cursor-mode +1))
-;; to always have centered-cursor-mode on in all buffers.
-
-;;; TODO:
-;; - the code is a mess
-;; - ccm-vpos-inverted doesn't work with ccm-vpos == 0, because first
-;; position from top is 0 and from bottom -1
-;; - interactive first start isn't animated when calling global-...
-;; because it starts the modes for each buffer and interactive-p fails
-;; for that
-;; - more bugs?
-
-;;; Change Log:
-;; 2009-08-31 andre-r
-;; * replaced window-body-height with window-text-height
-;; (partially visible lines are not counted in window-text-height)
-;; * bug fixed in ccm-vpos-recenter
-;; (some parentheses where wrong after the last update)
-;; 2009-02-23 andre-r
-;; * some simplifications
-;; 2009-02-22 andre-r
-;; * some tips from Drew Adams:
-;; - new local variable coding:utf-8
-;; - made recenter-sequence a defvar
-;; - added groups scrolling and convenience
-;; - replaced mouse-4 and mouse-5 with
-;; mouse-wheel-up-event and mouse-wheel-down-event
-;; - added scroll-bar-toolkit-scroll to ccm-ignored-commands
-;; - made ccm-ignored-commands customisable
-;; * removed a bug where it didn't work with more than one window
-;; displaying the same buffer
-;; * added function for page up and down scrolling
-;; (standard ones didn't work well with this mode)
-;; * made the animation delay customisable
-;; * made the initial vertical position customisable
-;; * made the behaviour at the end of the file customisable
-;; 2008-02-02 andre-r
-;; * fixed bug that led to wrong-type-argument
-;; when opening a new buffer
-;; * some other minor stuff
-;; 2007-09-24 andre-r
-;; * added global minor mode
-;; 2007-09-21 andre-r
-;; * not recentering at end of buffer
-;; * defvar animate-first-start-p
-;; 2007-09-14 andre-r
-;; * inital release
-
-;; This file is *NOT* part of GNU Emacs.
-
-;;; Code:
-
-(defgroup centered-cursor nil
- "Makes the cursor stay vertically in a defined position (usually centered).
-Instead the cursor the text moves around the cursor."
- :group 'scrolling
- :group 'convenience
- :link '(emacs-library-link :tag "Source Lisp File" "centered-cursor-mode.el")
- :link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/centered-cursor-mode.el"))
-
-(defcustom ccm-step-size 2
- "Step size when animated recentering."
- :group 'centered-cursor
- :tag "Animation step size"
- :type 'integer)
-
-(defcustom ccm-step-delay 0.02
- "Delay between animation steps.
-If you want a different animation speed."
- :group 'centered-cursor
- :tag "Animation step delay"
- :type 'number)
-
-(defcustom ccm-ignored-commands '(mouse-drag-region
- mouse-set-point
- widget-button-click
- scroll-bar-toolkit-scroll)
- "After these commands recentering is ignored.
-This is to prevent unintentional jumping (especially when mouse
-clicking). Following commands (except the ignored ones) will
-cause an animated recentering to give a feedback and not just
-jumping to the center."
- :group 'centered-cursor
- :tag "Ignored commands"
- :type '(repeat (symbol :tag "Command")))
-
-(defcustom ccm-vpos-init '(round (window-text-height) 2)
- "This is the screen line position where the cursor initially stays."
- :group 'centered-cursor
- :tag "Vertical cursor position"
- :type '(choice (const :tag "Center" (round (window-text-height) 2))
- (const :tag "Golden ratio" (round (* 21 (window-text-height)) 34))
- (integer :tag "Lines from top" :value 10)))
-(make-variable-buffer-local 'ccm-vpos-init)
-
-(defcustom ccm-vpos-inverted 1
- "Inverted vertical cursor position.
-Defines if the initial vertical position `ccm-vpos-init' is
-measured from the bottom instead from the top."
- :group 'centered-cursor
- :tag "Inverted cursor position"
- :type '(choice (const :tag "Inverted" -1)
- (const :tag "Not inverted" 1)))
-(make-variable-buffer-local 'ccm-vpos-inverted)
-
-(defcustom ccm-recenter-at-end-of-file nil
- "Recenter at the end of the file.
-If non-nil the end of the file is recentered. If nil the end of
-the file stays at the end of the window."
- :group 'centered-cursor
- :tag "Recenter at EOF"
- :type '(choice (const :tag "Don't recenter at the end of the file" nil)
- (const :tag "Recenter at the end of the file" t)))
-(make-variable-buffer-local 'ccm-recenter-end-of-file)
-
-(defvar ccm-vpos nil
- "This is the screen line position where the cursor stays.")
-(make-variable-buffer-local 'ccm-vpos)
-
-(defvar animate-first-start-p nil
- "Whether or not to animate at first start. It is set to nil, if
-centered-cursor-mode is called non-interactively.")
-(make-variable-buffer-local 'animate-first-start-p)
-
-(defvar recenter-sequence nil
- "Before animated recentering a list is generated first with positions
-to successively recenter to")
-(make-variable-buffer-local 'recenter-sequence)
-
-(defvar ccm-map
- (let ((ccm-map (make-sparse-keymap)))
- (define-key ccm-map [(control meta -)] 'ccm-vpos-up)
- (define-key ccm-map [(control meta +)] 'ccm-vpos-down)
- (define-key ccm-map [(control meta =)] 'ccm-vpos-down)
- (define-key ccm-map [(control meta ?0)] 'ccm-vpos-recenter)
- (when mouse-wheel-mode
- (mapc (lambda (key)
- (define-key ccm-map key 'ccm-mwheel-scroll))
- (list (vector mouse-wheel-up-event)
- (vector mouse-wheel-down-event)
- (vector (list 'control mouse-wheel-up-event))
- (vector (list 'control mouse-wheel-down-event))
- (vector (list 'shift mouse-wheel-up-event))
- (vector (list 'shift mouse-wheel-down-event)))))
- (define-key ccm-map [(meta v)] 'ccm-scroll-down)
- (define-key ccm-map [(control v)] 'ccm-scroll-up)
- (define-key ccm-map [prior] 'ccm-scroll-down)
- (define-key ccm-map [next] 'ccm-scroll-up)
- ccm-map)
- "Keymap used in centered-cursor-mode.")
-
-
-(defun ccm-mwheel-scroll (event)
- "Very similar to `mwheel-scroll', but does not use `scroll-down'
-and `scroll-up' but `previous-line' and `next-line', that is, the
-cursor is moved and thus the text in the window is scrolled
-due to `recenter'.
-
-The customizable variable `mouse-wheel-scroll-amount' is used to
-determine how much to scroll, where nil instead of a number means
-the same as in mwheel-scroll, scroll by a near full screen.
-
-This command exists, because mwheel-scroll caused strange
-behaviour with automatic recentering."
-;; (interactive (list last-input-event))
- (interactive "e")
- (let* ((mods (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
- (amt (assoc mods mouse-wheel-scroll-amount)))
- ;;(message "%S" mods)
- (if amt
- (setq amt (or (cdr amt)
- (- (window-text-height)
- next-screen-context-lines)))
- (let ((list-elt mouse-wheel-scroll-amount))
- (while (consp (setq amt (pop list-elt))))))
- (if mouse-wheel-follow-mouse
- (select-window (posn-window (event-start event))))
- (let ((button (mwheel-event-button event)))
- (cond
- ((eq button mouse-wheel-down-event)
- (forward-line (- amt)))
- ;;(princ amt))
- ((eq button mouse-wheel-up-event)
- (forward-line amt))
- ;;(princ amt))
- (t (error "Bad binding in ccm-mwheel-scroll"))))))
-
-(defun ccm-scroll-down (&optional arg)
- "Replaces `scroll-down' because with scroll-down
-`centered-cursor-mode' sometimes doesn't reach the top of the
-buffer. This version actually moves the cursor with
-`previous-line'. Since with centered-cursor-mode the cursor is in
-a fixed position the movement appears as page up."
- (interactive "P")
- (let ((amt (or arg (- (window-text-height)
- next-screen-context-lines))))
- (forward-line (- amt))))
-
-(defun ccm-scroll-up (&optional arg)
- "Replaces `scroll-up' to be consistent with `ccm-scroll-down'.
-This version actually moves the cursor with `previous-line'.
-Since with centered-cursor-mode the cursor is in a fixed position
-the movement appears as page up."
- (interactive "P")
- (let ((amt (or arg (- (window-text-height)
- next-screen-context-lines))))
- (forward-line amt)))
-
-
-(defun ccm-vpos-down (arg)
- "Adjust the value of the screen line (where the cursor stays) by arg.
-Negative values for arg are possible. Just the variable ccm-vpos
-is set."
- (interactive "p")
- (or arg (setq arg 1))
- (let ((new-pos (if (< ccm-vpos 0)
- (- ccm-vpos arg)
- (+ ccm-vpos arg)))
- ;; see pos-visible-in-window-p
- (vpos-max (if (< ccm-vpos 0)
- -1
- (- (window-text-height) 1)))
- (vpos-min (if (< ccm-vpos 0)
- (- (window-text-height))
- 0)))
- (setq ccm-vpos
- (cond
- ((< new-pos vpos-min)
- vpos-min)
- ((> new-pos vpos-max)
- vpos-max)
- (t
- new-pos)))))
-
-(defun ccm-vpos-up (arg)
- "See `ccm-vpos-down'."
- (interactive "p")
- (or arg (setq arg 1))
- (ccm-vpos-down (- arg)))
-
-(defun ccm-vpos-recenter ()
- "Set the value of the screen line (where the cursor stays) in
-the center. Just the variable ccm-vpos is set."
- (interactive)
- (if (equal (current-buffer)
- (window-buffer (selected-window)))
- (setq ccm-vpos (* (eval ccm-vpos-init)
- ccm-vpos-inverted))))
-
-(defun ccm-position-cursor ()
- "Do the actual recentering at the position `ccm-vpos'."
- (unless (member this-command ccm-ignored-commands)
- (unless ccm-vpos
- (ccm-vpos-recenter))
- (unless (minibufferp (current-buffer))
- (if (equal (current-buffer)
- (window-buffer (selected-window)))
- (let* ((current-line
- (if (< ccm-vpos 0)
- ;; one-based, from bottom, negative
- (- (count-lines (point)
- ;; window-end is sometimes < 0
- ;; when opening a help buffer
- (if (> (window-end) 0)
- (window-end)
- 1)))
- ;; zero-based, from top, positive
- (+ (count-lines (window-start) (point))
- ;; count-lines returns different value in column 0
- (if (= (current-column) 0) 0 -1))))
- (diff (- ccm-vpos current-line))
- (step-size ccm-step-size)
- (step-delay ccm-step-delay)
- (vpos-inverted ccm-vpos-inverted)
- (recenter-at-end-of-file ccm-recenter-at-end-of-file))
-
- (let* ((bottom-vpos (if (< ccm-vpos 0)
- (- ccm-vpos)
- (- (window-text-height) ccm-vpos)))
- (correction (save-excursion
- (if (or (= (point) (point-max))
- (progn
- (goto-char (point-max))
- (zerop (current-column))))
- 1 0)))
- ;; lines from point to end of buffer
- (bottom-lines (+ (count-lines (point) (point-max))
- correction)))
-
- ;; only animate if the point was moved rather far away
- ;; before by a mouseclick (see ccm-ignored-commands)
- ;; or if minor mode is just entered interactively
- (if (not (and (> (abs diff) 4)
- (or (member last-command ccm-ignored-commands)
- animate-first-start-p)))
-
- (recenter (if (and (< bottom-lines bottom-vpos)
- (not recenter-at-end-of-file))
- ;; if near the bottom, recenter in the
- ;; negative screen line that equals the
- ;; bottom buffer line, i.e. if we are in
- ;; the second last line (-2) of the
- ;; buffer, the cursor will be recentered
- ;; in -2
- (- bottom-lines)
- ccm-vpos))
-
- (setq animate-first-start-p nil)
- ;; first build a list with positions to successively recenter to
- (setq recenter-sequence
- ;; reverse: because we build the list not FROM -> TO but
- ;; TO -> FROM because if step size in number-sequence is
- ;; bigger than one, TO might not included, that means the
- ;; ccm-vpos would not be reached
- ;; cdr: don't recenter the current-line
- (if (and (< bottom-lines bottom-vpos)
- (not recenter-at-end-of-file))
- ;; this one is for animation near the bottom
- (cdr (reverse (number-sequence
- (- bottom-lines)
- (if (< ccm-vpos 0)
- current-line
- (- (- (window-text-height) current-line)))
- (* (/ diff (abs diff)) (- step-size)))))
- (cdr (reverse (number-sequence
- ccm-vpos
- current-line
- (* (/ diff (abs diff)) (- step-size)))))))
- ;; (message "%d %d %d (%d): %S" current-line ccm-vpos bottom-lines diff recenter-sequence)
- (while recenter-sequence
- ;; actual animation
- (recenter (pop recenter-sequence))
- (if (car recenter-sequence) (sit-for step-delay t))))))))))
-
-(defun ccm-first-start (animate)
- "Called from centered-cursor-mode. Animate at first start, if
-centered-cursor-mode is called interactively."
- (let ((animate-first-start-p animate))
- (ccm-vpos-recenter)
- (ccm-position-cursor)))
-
-;;(defalias 'ccm 'centered-cursor-mode)
-(define-minor-mode centered-cursor-mode
- "Makes the cursor stay vertically in a defined
-position (usually centered)."
- :init-value nil
-;; :lighter nil
- :lighter " ¢"
- :keymap ccm-map
- (cond
- (centered-cursor-mode
- (ccm-first-start (interactive-p))
- (add-hook 'post-command-hook 'ccm-position-cursor t t)
- (add-hook 'window-configuration-change-hook 'ccm-vpos-recenter t t))
- (t
- (remove-hook 'post-command-hook 'ccm-position-cursor t)
- (remove-hook 'window-configuration-change-hook 'ccm-vpos-recenter t))))
-
-
-(define-global-minor-mode global-centered-cursor-mode centered-cursor-mode
- centered-cursor-mode)
-
-(provide 'centered-cursor-mode)
-
-;;; Help:
-;; (info "(elisp)Defining Minor Modes")
-;; (info "(elisp)Screen Lines")
-;; (info "(elisp)Hooks")
-;; (info "(elisp)Customization")
-;; (find-function 'mwheel-scroll)
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
-;;; centered-cursor-mode.el ends here
--- /dev/null
+;;; ace-jump-mode-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+\f
+;;;### (autoloads (ace-jump-mode ace-jump-line-mode ace-jump-word-mode
+;;;;;; ace-jump-char-mode ace-jump-mode-pop-mark) "ace-jump-mode"
+;;;;;; "ace-jump-mode.el" (21823 16778 0 0))
+;;; Generated autoloads from ace-jump-mode.el
+
+(autoload 'ace-jump-mode-pop-mark "ace-jump-mode" "\
+Pop up a postion from `ace-jump-mode-mark-ring', and jump back to that position
+
+\(fn)" t nil)
+
+(autoload 'ace-jump-char-mode "ace-jump-mode" "\
+AceJump char mode
+
+\(fn QUERY-CHAR)" t nil)
+
+(autoload 'ace-jump-word-mode "ace-jump-mode" "\
+AceJump word mode.
+You can set `ace-jump-word-mode-use-query-char' to nil to prevent
+asking for a head char, that will mark all the word in current
+buffer.
+
+\(fn HEAD-CHAR)" t nil)
+
+(autoload 'ace-jump-line-mode "ace-jump-mode" "\
+AceJump line mode.
+Marked each no empty line and move there
+
+\(fn)" t nil)
+
+(autoload 'ace-jump-mode "ace-jump-mode" "\
+AceJump mode is a minor mode for you to quick jump to a
+position in the curret view.
+ There is three submode now:
+ `ace-jump-char-mode'
+ `ace-jump-word-mode'
+ `ace-jump-line-mode'
+
+You can specify the sequence about which mode should enter
+by customize `ace-jump-mode-submode-list'.
+
+If you do not want to query char for word mode, you can change
+`ace-jump-word-mode-use-query-char' to nil.
+
+If you don't like the default move keys, you can change it by
+setting `ace-jump-mode-move-keys'.
+
+You can constrol whether use the case sensitive via
+`ace-jump-mode-case-fold'.
+
+\(fn &optional PREFIX)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("ace-jump-mode-pkg.el") (21823 16778 629811
+;;;;;; 0))
+
+;;;***
+\f
+(provide 'ace-jump-mode-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; ace-jump-mode-autoloads.el ends here
--- /dev/null
+(define-package "ace-jump-mode" "20140616.115" "a quick cursor location minor mode for emacs" (quote nil))
--- /dev/null
+;;; ace-jump-mode.el --- a quick cursor location minor mode for emacs -*- coding: utf-8-unix -*-
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author : winterTTr <winterTTrNOSPAMgmail.com>
+;; URL : https://github.com/winterTTr/ace-jump-mode/
+;; Package-Version: 20140616.115
+;; Version : 2.0.RC
+;; Keywords : motion, location, cursor
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; INTRODUCTION
+;;
+
+;; What's this?
+;;
+;; It is a minor mode for Emacs. It can help you to move your cursor
+;; to ANY position in emacs by using only 3 times key press.
+
+;; Where does ace jump mode come from ?
+;;
+;; I firstly see such kind of moving style is in a vim plugin called
+;; EasyMotion. It really attract me a lot. So I decide to write
+;; one for Emacs and MAKE IT BETTER.
+;;
+;; So I want to thank to :
+;; Bartlomiej P. for his PreciseJump
+;; Kim Silkebækken for his EasyMotion
+
+
+;; What's ace-jump-mode ?
+;;
+;; ace-jump-mode is an fast/direct cursor location minor mode. It will
+;; create the N-Branch search tree internal and marks all the possible
+;; position with predefined keys in within the whole emacs view.
+;; Allowing you to move to the character/word/line almost directly.
+;;
+
+;;; Usage
+;;
+;; Add the following code to your init file, of course you can select
+;; the key that you prefer to.
+;; ----------------------------------------------------------
+;; ;;
+;; ;; ace jump mode major function
+;; ;;
+;; (add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/")
+;; (autoload
+;; 'ace-jump-mode
+;; "ace-jump-mode"
+;; "Emacs quick move minor mode"
+;; t)
+;; ;; you can select the key you prefer to
+;; (define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
+;;
+;; ;;
+;; ;; enable a more powerful jump back function from ace jump mode
+;; ;;
+;; (autoload
+;; 'ace-jump-mode-pop-mark
+;; "ace-jump-mode"
+;; "Ace jump back:-)"
+;; t)
+;; (eval-after-load "ace-jump-mode"
+;; '(ace-jump-mode-enable-mark-sync))
+;; (define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark)
+;;
+;; ;;If you use viper mode :
+;; (define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode)
+;; ;;If you use evil
+;; (define-key evil-normal-state-map (kbd "SPC") 'ace-jump-mode)
+;; ----------------------------------------------------------
+
+;;; For more information
+;; Intro Doc: https://github.com/winterTTr/ace-jump-mode/wiki
+;; FAQ : https://github.com/winterTTr/ace-jump-mode/wiki/AceJump-FAQ
+
+;;; Code:
+
+(require 'cl)
+
+;;;; ============================================
+;;;; Utilities for ace-jump-mode
+;;;; ============================================
+
+;; ---------------------
+;; aj-position
+;; ---------------------
+
+;; make a position in a visual area
+(defstruct aj-position offset visual-area)
+
+(defmacro aj-position-buffer (aj-pos)
+ "Get the buffer object from `aj-position'."
+ `(aj-visual-area-buffer (aj-position-visual-area ,aj-pos)))
+
+(defmacro aj-position-window (aj-pos)
+ "Get the window object from `aj-position'."
+ `(aj-visual-area-window (aj-position-visual-area ,aj-pos)))
+
+(defmacro aj-position-frame (aj-pos)
+ "Get the frame object from `aj-position'."
+ `(aj-visual-area-frame (aj-position-visual-area ,aj-pos)))
+
+(defmacro aj-position-recover-buffer (aj-pos)
+ "Get the recover-buffer object from `aj-position'."
+ `(aj-visual-area-recover-buffer (aj-position-visual-area ,aj-pos)))
+
+
+;; ---------------------
+;; aj-visual-area
+;; ---------------------
+
+;; a record for all the possible visual area
+;; a visual area is a window that showing some buffer in some frame.
+(defstruct aj-visual-area buffer window frame recover-buffer)
+
+
+;; ---------------------
+;; a FIFO queue implementation
+;; ---------------------
+(defstruct aj-queue head tail)
+
+(defun aj-queue-push (item q)
+ "enqueue"
+ (let ( (head (aj-queue-head q) )
+ (tail (aj-queue-tail q) )
+ (c (list item) ) )
+ (cond
+ ((null (aj-queue-head q))
+ (setf (aj-queue-head q) c)
+ (setf (aj-queue-tail q) c))
+ (t
+ (setf (cdr (aj-queue-tail q)) c)
+ (setf (aj-queue-tail q) c)))))
+
+(defun aj-queue-pop (q)
+ "dequeue"
+ (if (null (aj-queue-head q))
+ (error "[AceJump] Interal Error: Empty queue"))
+
+ (let ((ret (aj-queue-head q)))
+ (if (eq ret (aj-queue-tail q))
+ ;; only one item left
+ (progn
+ (setf (aj-queue-head q) nil)
+ (setf (aj-queue-tail q) nil))
+ ;; multi item left, move forward the head
+ (setf (aj-queue-head q) (cdr ret)))
+ (car ret)))
+
+
+
+;;; main code start here
+
+;; register as a minor mode
+(or (assq 'ace-jump-mode minor-mode-alist)
+ (nconc minor-mode-alist
+ (list '(ace-jump-mode ace-jump-mode))))
+
+;; custoize variable
+(defvar ace-jump-word-mode-use-query-char t
+ "If we need to ask for the query char before enter `ace-jump-word-mode'")
+
+(defvar ace-jump-mode-case-fold case-fold-search
+ "If non-nil, the ace-jump mode will ignore case.
+
+The default value is set to the same as `case-fold-search'.")
+
+(defvar ace-jump-mode-mark-ring nil
+ "The list that is used to store the history for jump back.")
+
+(defvar ace-jump-mode-mark-ring-max 100
+ "The max length of `ace-jump-mode-mark-ring'")
+
+
+(defvar ace-jump-mode-gray-background t
+ "By default, when there is more than one candidate, the ace
+jump mode will gray the background and then mark the possible
+candidate position. Set this to nil means do not gray
+background.")
+
+(defvar ace-jump-mode-scope 'global
+ "Define what is the scope that ace-jump-mode works.
+
+Now, there are four kinds of values for this:
+1. 'global : ace jump can work across any window and frame, this is also the default.
+2. 'frame : ace jump will work for the all windows in current frame.
+3. 'visible : ace jump will work for all windows in visible frames.
+3. 'window : ace jump will only work on current window only.
+ This is the same behavior for 1.0 version.")
+
+(defvar ace-jump-mode-detect-punc t
+ "When this is non-nil, the ace jump word mode will detect the
+char that is not alpha or number. Then, if the query char is a
+printable punctuaction, we will use char mode to start the ace
+jump mode. If it is nil, an error will come up when
+non-alpha-number is given under word mode.")
+
+
+(defvar ace-jump-mode-submode-list
+ '(ace-jump-word-mode
+ ace-jump-char-mode
+ ace-jump-line-mode)
+ "*The mode list when start ace jump mode.
+The sequence is the calling sequence when give prefix argument.
+
+Such as:
+ If you use the default sequence, which is
+ '(ace-jump-word-mode
+ ace-jump-char-mode
+ ace-jump-line-mode)
+and using key to start up ace jump mode, such as 'C-c SPC',
+then the usage to start each mode is as below:
+
+ C-c SPC ==> ace-jump-word-mode
+ C-u C-c SPC ==> ace-jump-char-mode
+ C-u C-u C-c SPC ==> ace-jump-line-mode
+
+Currently, the valid submode is:
+ `ace-jump-word-mode'
+ `ace-jump-char-mode'
+ `ace-jump-line-mode'
+
+")
+
+(defvar ace-jump-mode-move-keys
+ (nconc (loop for i from ?a to ?z collect i)
+ (loop for i from ?A to ?Z collect i))
+ "*The keys that used to move when enter AceJump mode.
+Each key should only an printable character, whose name will
+fill each possible location.
+
+If you want your own moving keys, you can custom that as follow,
+for example, you only want to use lower case character:
+\(setq ace-jump-mode-move-keys (loop for i from ?a to ?z collect i)) ")
+
+
+;;; some internal variable for ace jump
+(defvar ace-jump-mode nil
+ "AceJump minor mode.")
+(defvar ace-jump-background-overlay-list nil
+ "Background overlay which will grey all the display.")
+(defvar ace-jump-search-tree nil
+ "N-branch Search tree. Every leaf node holds the overlay that
+is used to highlight the target positions.")
+(defvar ace-jump-query-char nil
+ "Save the query char used between internal mode.")
+(defvar ace-jump-current-mode nil
+ "Save the current mode.
+See `ace-jump-mode-submode-list' for possible value.")
+
+(defvar ace-jump-sync-emacs-mark-ring nil
+ "When this variable is not-nil, everytime `ace-jump-mode-pop-mark' is called,
+ace jump will try to remove the same mark from buffer local mark
+ring and global-mark-ring, which help you to sync the mark
+information between emacs and ace jump.
+
+Note, never try to set this variable manually, this is for ace
+jump internal use. If you want to change it, use
+`ace-jump-mode-enable-mark-sync' or
+`ace-jump-mode-disable-mark-sync'.")
+
+(defvar ace-jump-search-filter nil
+ "This should be nil or a point-dependant predicate
+that `ace-jump-search-candidate' will use as an additional filter.")
+
+(defgroup ace-jump nil
+ "ace jump group"
+ :group 'convenience)
+
+;;; define the face
+(defface ace-jump-face-background
+ '((t (:foreground "gray40")))
+ "Face for background of AceJump motion"
+ :group 'ace-jump)
+
+
+(defface ace-jump-face-foreground
+ '((((class color)) (:foreground "red" :underline nil))
+ (((background dark)) (:foreground "gray100" :underline nil))
+ (((background light)) (:foreground "gray0" :underline nil))
+ (t (:foreground "gray100" :underline nil)))
+ "Face for foreground of AceJump motion"
+ :group 'ace-jump)
+
+
+(defvar ace-jump-mode-before-jump-hook nil
+ "Function(s) to call just before moving the cursor to a selected match")
+
+(defvar ace-jump-mode-end-hook nil
+ "Function(s) to call when ace-jump-mode is going to end up")
+
+(defvar ace-jump-allow-invisible nil
+ "Control if ace-jump should select the invisible char as candidate.
+Normally, the ace jump mark cannot be seen if the target character is invisible.
+So default to be nil, which will not include those invisible character as candidate.")
+
+
+(defun ace-jump-char-category ( query-char )
+ "Detect the type of the char.
+For the ascii table, refer to http://www.asciitable.com/
+
+There is four possible return value:
+1. 'digit: the number character
+2. 'alpha: A-Z and a-z
+3. 'punc : all the printable punctuaiton
+4. 'other: all the others"
+ (cond
+ ;; digit
+ ((and (>= query-char #x30) (<= query-char #x39))
+ 'digit)
+ ((or
+ ;; capital letter
+ (and (>= query-char #x41) (<= query-char #x5A))
+ ;; lowercase letter
+ (and (>= query-char #x61) (<= query-char #x7A)))
+ 'alpha)
+ ((or
+ ;; tab
+ (equal query-char #x9)
+ ;; punc before digit
+ (and (>= query-char #x20) (<= query-char #x2F))
+ ;; punc after digit before capital letter
+ (and (>= query-char #x3A) (<= query-char #x40))
+ ;; punc after capital letter before lowercase letter
+ (and (>= query-char #x5B) (<= query-char #x60))
+ ;; punc after lowercase letter
+ (and (>= query-char #x7B) (<= query-char #x7E)))
+ 'punc)
+ (t
+ 'other)))
+
+
+(defun ace-jump-search-candidate (re-query-string visual-area-list)
+ "Search the RE-QUERY-STRING in current view, and return the candidate position list.
+RE-QUERY-STRING should be an valid regex used for `search-forward-regexp'.
+
+You can control whether use the case sensitive or not by `ace-jump-mode-case-fold'.
+
+Every possible `match-beginning' will be collected.
+The returned value is a list of `aj-position' record."
+ (loop for va in visual-area-list
+ append (let* ((current-window (aj-visual-area-window va))
+ (start-point (window-start current-window))
+ (end-point (window-end current-window t)))
+ (with-selected-window current-window
+ (save-excursion
+ (goto-char start-point)
+ (let ((case-fold-search ace-jump-mode-case-fold))
+ (loop while (re-search-forward re-query-string nil t)
+ until (or
+ (> (point) end-point)
+ (eobp))
+ if (and (or ace-jump-allow-invisible (not (invisible-p (match-beginning 0))))
+ (or (null ace-jump-search-filter)
+ (ignore-errors
+ (funcall ace-jump-search-filter))))
+ collect (make-aj-position :offset (match-beginning 0)
+ :visual-area va)
+ ;; when we use "^" to search line mode,
+ ;; re-search-backward will not move one
+ ;; char after search success, as line
+ ;; begin is not a valid visible char.
+ ;; We need to help it to move forward.
+ do (if (string-equal re-query-string "^")
+ (goto-char (1+ (match-beginning 0)))))))))))
+
+(defun ace-jump-tree-breadth-first-construct (total-leaf-node max-child-node)
+ "Constrct the search tree, each item in the tree is a cons cell.
+The (car tree-node) is the type, which should be only 'branch or 'leaf.
+The (cdr tree-node) is data stored in a leaf when type is 'leaf,
+while a child node list when type is 'branch"
+ (let ((left-leaf-node (- total-leaf-node 1))
+ (q (make-aj-queue))
+ (node nil)
+ (root (cons 'leaf nil)) )
+ ;; we push the node into queue and make candidate-sum -1, so
+ ;; create the start condition for the while loop
+ (aj-queue-push root q)
+ (while (> left-leaf-node 0)
+ (setq node (aj-queue-pop q))
+ ;; when a node is picked up from stack, it will be changed to a
+ ;; branch node, we lose a leaft node
+ (setf (car node) 'branch)
+ ;; so we need to add the sum of leaf nodes that we wish to create
+ (setq left-leaf-node (1+ left-leaf-node))
+ (if (<= left-leaf-node max-child-node)
+ ;; current child can fill the left leaf
+ (progn
+ (setf (cdr node)
+ (loop for i from 1 to left-leaf-node
+ collect (cons 'leaf nil)))
+ ;; so this should be the last action for while
+ (setq left-leaf-node 0))
+ ;; the child can not cover the left leaf
+ (progn
+ ;; fill as much as possible. Push them to queue, so it have
+ ;; the oppotunity to become 'branch node if necessary
+ (setf (cdr node)
+ (loop for i from 1 to max-child-node
+ collect (let ((n (cons 'leaf nil)))
+ (aj-queue-push n q)
+ n)))
+ (setq left-leaf-node (- left-leaf-node max-child-node)))))
+ ;; return the root node
+ root))
+
+(defun ace-jump-tree-preorder-traverse (tree &optional leaf-func branch-func)
+ "we move over tree via preorder, and call BRANCH-FUNC on each branch
+node and call LEAF-FUNC on each leaf node"
+ ;; use stack to do preorder traverse
+ (let ((s (list tree)))
+ (while (not (null s))
+ ;; pick up one from stack
+ (let ((node (car s)))
+ ;; update stack
+ (setq s (cdr s))
+ (cond
+ ((eq (car node) 'branch)
+ ;; a branch node
+ (when branch-func
+ (funcall branch-func node))
+ ;; push all child node into stack
+ (setq s (append (cdr node) s)))
+ ((eq (car node) 'leaf)
+ (when leaf-func
+ (funcall leaf-func node)))
+ (t
+ (message "[AceJump] Internal Error: invalid tree node type")))))))
+
+
+(defun ace-jump-populate-overlay-to-search-tree (tree candidate-list)
+ "Populate the overlay to search tree, every leaf will give one overlay"
+
+ (lexical-let* (;; create the locally dynamic variable for the following function
+ (position-list candidate-list)
+
+ ;; make the function to create overlay for each leaf node,
+ ;; here we only create each overlay for each candidate
+ ;; position, , but leave the 'display property to be empty,
+ ;; which will be fill in "update-overlay" function
+ (func-create-overlay (lambda (node)
+ (let* ((p (car position-list))
+ (o (aj-position-offset p))
+ (w (aj-position-window p))
+ (b (aj-position-buffer p))
+ ;; create one char overlay
+ (ol (make-overlay o (1+ o) b)))
+ ;; update leaf node to remember the ol
+ (setf (cdr node) ol)
+ (overlay-put ol 'face 'ace-jump-face-foreground)
+ ;; this is important, because sometimes the different
+ ;; window may dispaly the same buffer, in that case,
+ ;; overlay for different window (but the same buffer)
+ ;; will show at the same time on both window
+ ;; So we make it only on the specific window
+ (overlay-put ol 'window w)
+ ;; associate the aj-position data with overlay
+ ;; so that we can use it to do the final jump
+ (overlay-put ol 'aj-data p)
+ ;; next candidate node
+ (setq position-list (cdr position-list))))))
+ (ace-jump-tree-preorder-traverse tree func-create-overlay)
+ tree))
+
+
+(defun ace-jump-delete-overlay-in-search-tree (tree)
+ "Delete all the overlay in search tree leaf node"
+ (let ((func-delete-overlay (lambda (node)
+ (delete-overlay (cdr node))
+ (setf (cdr node) nil))))
+ (ace-jump-tree-preorder-traverse tree func-delete-overlay)))
+
+(defun ace-jump-buffer-substring (pos)
+ "Get the char under the POS, which is aj-position structure."
+ (let* ((w (aj-position-window pos))
+ (offset (aj-position-offset pos)))
+ (with-selected-window w
+ (buffer-substring offset (1+ offset)))))
+
+(defun ace-jump-update-overlay-in-search-tree (tree keys)
+ "Update overlay 'display property using each name in keys"
+ (lexical-let* (;; create dynamic variable for following function
+ (key ?\0)
+ ;; populdate each leaf node to be the specific key,
+ ;; this only update 'display' property of overlay,
+ ;; so that user can see the key from screen and select
+ (func-update-overlay
+ (lambda (node)
+ (let ((ol (cdr node)))
+ (overlay-put
+ ol
+ 'display
+ (concat (make-string 1 key)
+ (let* ((pos (overlay-get ol 'aj-data))
+ (subs (ace-jump-buffer-substring pos)))
+ (cond
+ ;; when tab, we use more space to prevent screen
+ ;; from messing up
+ ((string-equal subs "\t")
+ (make-string (1- tab-width) ? ))
+ ;; when enter, we need to add one more enter
+ ;; to make the screen not change
+ ((string-equal subs "\n")
+ "\n")
+ (t
+ ;; there are wide-width characters
+ ;; so, we need paddings
+ (make-string (max 0 (1- (string-width subs))) ? ))))))))))
+ (loop for k in keys
+ for n in (cdr tree)
+ do (progn
+ ;; update "key" variable so that the function can use
+ ;; the correct context
+ (setq key k)
+ (if (eq (car n) 'branch)
+ (ace-jump-tree-preorder-traverse n
+ func-update-overlay)
+ (funcall func-update-overlay n))))))
+
+
+
+(defun ace-jump-list-visual-area()
+ "Based on `ace-jump-mode-scope', search the possible buffers that is showing now."
+ (cond
+ ((eq ace-jump-mode-scope 'global)
+ (loop for f in (frame-list)
+ append (loop for w in (window-list f)
+ collect (make-aj-visual-area :buffer (window-buffer w)
+ :window w
+ :frame f))))
+ ((eq ace-jump-mode-scope 'visible)
+ (loop for f in (frame-list)
+ if (eq t (frame-visible-p f))
+ append (loop for w in (window-list f)
+ collect (make-aj-visual-area :buffer (window-buffer w)
+ :window w
+ :frame f))))
+ ((eq ace-jump-mode-scope 'frame)
+ (loop for w in (window-list (selected-frame))
+ collect (make-aj-visual-area :buffer (window-buffer w)
+ :window w
+ :frame (selected-frame))))
+ ((eq ace-jump-mode-scope 'window)
+ (list
+ (make-aj-visual-area :buffer (current-buffer)
+ :window (selected-window)
+ :frame (selected-frame))))
+ (t
+ (error "[AceJump] Invalid ace-jump-mode-scope, please check your configuration"))))
+
+
+
+(defun ace-jump-do( re-query-string )
+ "The main function to start the AceJump mode.
+QUERY-STRING should be a valid regexp string, which finally pass to `search-forward-regexp'.
+
+You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
+"
+ ;; we check the move key to make it valid, cause it can be customized by user
+ (if (or (null ace-jump-mode-move-keys)
+ (< (length ace-jump-mode-move-keys) 2)
+ (not (every #'characterp ace-jump-mode-move-keys)))
+ (error "[AceJump] Invalid move keys: check ace-jump-mode-move-keys"))
+ ;; search candidate position
+ (let* ((visual-area-list (ace-jump-list-visual-area))
+ (candidate-list (ace-jump-search-candidate re-query-string visual-area-list)))
+ (cond
+ ;; cannot find any one
+ ((null candidate-list)
+ (setq ace-jump-current-mode nil)
+ (error "[AceJump] No one found"))
+ ;; we only find one, so move to it directly
+ ((eq (cdr candidate-list) nil)
+ (ace-jump-push-mark)
+ (run-hooks 'ace-jump-mode-before-jump-hook)
+ (ace-jump-jump-to (car candidate-list))
+ (message "[AceJump] One candidate, move to it directly")
+ (run-hooks 'ace-jump-mode-end-hook))
+ ;; more than one, we need to enter AceJump mode
+ (t
+ ;; create background for each visual area
+ (if ace-jump-mode-gray-background
+ (setq ace-jump-background-overlay-list
+ (loop for va in visual-area-list
+ collect (let* ((w (aj-visual-area-window va))
+ (b (aj-visual-area-buffer va))
+ (ol (make-overlay (window-start w)
+ (window-end w)
+ b)))
+ (overlay-put ol 'face 'ace-jump-face-background)
+ ol))))
+
+ ;; construct search tree and populate overlay into tree
+ (setq ace-jump-search-tree
+ (ace-jump-tree-breadth-first-construct (length candidate-list)
+ (length ace-jump-mode-move-keys)))
+ (ace-jump-populate-overlay-to-search-tree ace-jump-search-tree
+ candidate-list)
+ (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
+ ace-jump-mode-move-keys)
+
+ ;; do minor mode configuration
+ (cond
+ ((eq ace-jump-current-mode 'ace-jump-char-mode)
+ (setq ace-jump-mode " AceJump - Char"))
+ ((eq ace-jump-current-mode 'ace-jump-word-mode)
+ (setq ace-jump-mode " AceJump - Word"))
+ ((eq ace-jump-current-mode 'ace-jump-line-mode)
+ (setq ace-jump-mode " AceJump - Line"))
+ (t
+ (setq ace-jump-mode " AceJump")))
+ (force-mode-line-update)
+
+
+ ;; override the local key map
+ (setq overriding-local-map
+ (let ( (map (make-keymap)) )
+ (dolist (key-code ace-jump-mode-move-keys)
+ (define-key map (make-string 1 key-code) 'ace-jump-move))
+ (define-key map (kbd "C-c C-c") 'ace-jump-quick-exchange)
+ (define-key map [t] 'ace-jump-done)
+ map))
+
+ (add-hook 'mouse-leave-buffer-hook 'ace-jump-done)
+ (add-hook 'kbd-macro-termination-hook 'ace-jump-done)))))
+
+
+(defun ace-jump-jump-to (position)
+ "Jump to the POSITION, which is a `aj-position' structure storing the position information"
+ (let ((offset (aj-position-offset position))
+ (frame (aj-position-frame position))
+ (window (aj-position-window position))
+ (buffer (aj-position-buffer position))
+ (line-mode-column 0))
+
+ ;; save the column before do line jump, so that we can jump to the
+ ;; same column as previous line, make it the same behavior as C-n/C-p
+ (if (eq ace-jump-current-mode 'ace-jump-line-mode)
+ (setq line-mode-column (current-column)))
+
+ ;; focus to the frame
+ (if (and (frame-live-p frame)
+ (not (eq frame (selected-frame))))
+ (select-frame-set-input-focus (window-frame window)))
+
+ ;; select the correct window
+ (if (and (window-live-p window)
+ (not (eq window (selected-window))))
+ (select-window window))
+
+ ;; swith to buffer
+ (if (and (buffer-live-p buffer)
+ (not (eq buffer (window-buffer window))))
+ (switch-to-buffer buffer))
+
+ ;; move to correct position
+ (if (and (buffer-live-p buffer)
+ (eq (current-buffer) buffer))
+ (goto-char offset))
+
+ ;; recover to the same column if we use the line jump mode
+ (if (eq ace-jump-current-mode 'ace-jump-line-mode)
+ (move-to-column line-mode-column))
+ ))
+
+(defun ace-jump-push-mark ()
+ "Push the current position information onto the `ace-jump-mode-mark-ring'."
+ ;; add mark to the emacs basic push mark
+ (push-mark (point) t)
+ ;; we also push the mark on the `ace-jump-mode-mark-ring', which has
+ ;; more information for better jump back
+ (let ((pos (make-aj-position :offset (point)
+ :visual-area (make-aj-visual-area :buffer (current-buffer)
+ :window (selected-window)
+ :frame (selected-frame)))))
+ (setq ace-jump-mode-mark-ring (cons pos ace-jump-mode-mark-ring)))
+ ;; when exeed the max count, discard the last one
+ (if (> (length ace-jump-mode-mark-ring) ace-jump-mode-mark-ring-max)
+ (setcdr (nthcdr (1- ace-jump-mode-mark-ring-max) ace-jump-mode-mark-ring) nil)))
+
+
+;;;###autoload
+(defun ace-jump-mode-pop-mark ()
+ "Pop up a postion from `ace-jump-mode-mark-ring', and jump back to that position"
+ (interactive)
+ ;; we jump over the killed buffer position
+ (while (and ace-jump-mode-mark-ring
+ (not (buffer-live-p (aj-position-buffer
+ (car ace-jump-mode-mark-ring)))))
+ (setq ace-jump-mode-mark-ring (cdr ace-jump-mode-mark-ring)))
+
+ (if (null ace-jump-mode-mark-ring)
+ ;; no valid history exist
+ (error "[AceJump] No more history"))
+
+ (if ace-jump-sync-emacs-mark-ring
+ (let ((p (car ace-jump-mode-mark-ring)))
+ ;; if we are jump back in the current buffer, that means we
+ ;; only need to sync the buffer local mark-ring
+ (if (eq (current-buffer) (aj-position-buffer p))
+ (if (equal (aj-position-offset p) (marker-position (mark-marker)))
+ ;; if the current marker is the same as where we need
+ ;; to jump back, we do the same as pop-mark actually,
+ ;; copy implementation from pop-mark, cannot use it
+ ;; directly, as there is advice on it
+ (when mark-ring
+ (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
+ (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
+ (move-marker (car mark-ring) nil)
+ (setq mark-ring (cdr mark-ring))
+ (deactivate-mark))
+
+ ;; But if there is other marker put before the wanted destination, the following scenario
+ ;;
+ ;; +---+---+---+---+ +---+---+---+---+
+ ;; Mark Ring | 2 | 3 | 4 | 5 | | 2 | 4 | 5 | 3 |
+ ;; +---+---+---+---+ +---+---+---+---+
+ ;; +---+ +---+
+ ;; Marker | 1 | | 1 | <-- Maker (not changed)
+ ;; +---+ +---+
+ ;; +---+ +---+
+ ;; Cursor | X | Pop up AJ mark 3 | 3 | <-- Cursor position
+ ;; +---+ +---+
+ ;; +---+---+---+ +---+---+---+
+ ;; AJ Ring | 3 | 4 | 5 | | 4 | 5 | 3 |
+ ;; +---+---+---+ +---+---+---+
+ ;;
+ ;; So what we need to do, is put the found mark in mark-ring to the end
+ (lexical-let ((po (aj-position-offset p)))
+ (setq mark-ring
+ (ace-jump-move-first-to-end-if mark-ring
+ (lambda (x)
+ (equal (marker-position x) po))))))
+
+
+ ;; when we jump back to another buffer, do as the
+ ;; pop-global-mark does. But we move the marker with the
+ ;; same target buffer to the end, not always the first one
+ (lexical-let ((pb (aj-position-buffer p)))
+ (setq global-mark-ring
+ (ace-jump-move-first-to-end-if global-mark-ring
+ (lambda (x)
+ (eq (marker-buffer x) pb))))))))
+
+
+ ;; move the first element to the end of the ring
+ (ace-jump-jump-to (car ace-jump-mode-mark-ring))
+ (setq ace-jump-mode-mark-ring (nconc (cdr ace-jump-mode-mark-ring)
+ (list (car ace-jump-mode-mark-ring)))))
+
+(defun ace-jump-quick-exchange ()
+ "The function that we can use to quick exhange the current mode between
+word-mode and char-mode"
+ (interactive)
+ (cond
+ ((eq ace-jump-current-mode 'ace-jump-char-mode)
+ (if ace-jump-query-char
+ ;; ace-jump-done will clean the query char, so we need to save it
+ (let ((query-char ace-jump-query-char))
+ (ace-jump-done)
+ (ace-jump-word-mode query-char))))
+ ((eq ace-jump-current-mode 'ace-jump-word-mode)
+ (if ace-jump-query-char
+ ;; ace-jump-done will clean the query char, so we need to save it
+ (let ((query-char ace-jump-query-char))
+ (ace-jump-done)
+ ;; restore the flag
+ (ace-jump-char-mode query-char))))
+ ((eq ace-jump-current-mode 'ace-jump-line-mode)
+ nil)
+ (t
+ nil)))
+
+
+
+
+;;;###autoload
+(defun ace-jump-char-mode (query-char)
+ "AceJump char mode"
+ (interactive (list (read-char "Query Char:")))
+
+ ;; We should prevent recursion call this function. This can happen
+ ;; when you trigger the key for ace jump again when already in ace
+ ;; jump mode. So we stop the previous one first.
+ (if ace-jump-current-mode (ace-jump-done))
+
+ (if (eq (ace-jump-char-category query-char) 'other)
+ (error "[AceJump] Non-printable character"))
+
+ ;; others : digit , alpha, punc
+ (setq ace-jump-query-char query-char)
+ (setq ace-jump-current-mode 'ace-jump-char-mode)
+ (ace-jump-do (regexp-quote (make-string 1 query-char))))
+
+
+;;;###autoload
+(defun ace-jump-word-mode (head-char)
+ "AceJump word mode.
+You can set `ace-jump-word-mode-use-query-char' to nil to prevent
+asking for a head char, that will mark all the word in current
+buffer."
+ (interactive (list (if ace-jump-word-mode-use-query-char
+ (read-char "Head Char:")
+ nil)))
+
+ ;; We should prevent recursion call this function. This can happen
+ ;; when you trigger the key for ace jump again when already in ace
+ ;; jump mode. So we stop the previous one first.
+ (if ace-jump-current-mode (ace-jump-done))
+
+ (cond
+ ((null head-char)
+ ;; \< - start of word
+ ;; \sw - word constituent
+ (ace-jump-do "\\<\\sw"))
+ ((memq (ace-jump-char-category head-char)
+ '(digit alpha))
+ (setq ace-jump-query-char head-char)
+ (setq ace-jump-current-mode 'ace-jump-word-mode)
+ (ace-jump-do (concat "\\<" (make-string 1 head-char))))
+ ((eq (ace-jump-char-category head-char)
+ 'punc)
+ ;; we do not query punctuation under word mode
+ (if (null ace-jump-mode-detect-punc)
+ (error "[AceJump] Not a valid word constituent"))
+ ;; we will use char mode to continue search
+ (setq ace-jump-query-char head-char)
+ (setq ace-jump-current-mode 'ace-jump-char-mode)
+ (ace-jump-do (regexp-quote (make-string 1 head-char))))
+ (t
+ (error "[AceJump] Non-printable character"))))
+
+
+;;;###autoload
+(defun ace-jump-line-mode ()
+ "AceJump line mode.
+Marked each no empty line and move there"
+ (interactive)
+
+ ;; We should prevent recursion call this function. This can happen
+ ;; when you trigger the key for ace jump again when already in ace
+ ;; jump mode. So we stop the previous one first.
+ (if ace-jump-current-mode (ace-jump-done))
+
+ (setq ace-jump-current-mode 'ace-jump-line-mode)
+ (ace-jump-do "^"))
+
+;;;###autoload
+(defun ace-jump-mode(&optional prefix)
+ "AceJump mode is a minor mode for you to quick jump to a
+position in the curret view.
+ There is three submode now:
+ `ace-jump-char-mode'
+ `ace-jump-word-mode'
+ `ace-jump-line-mode'
+
+You can specify the sequence about which mode should enter
+by customize `ace-jump-mode-submode-list'.
+
+If you do not want to query char for word mode, you can change
+`ace-jump-word-mode-use-query-char' to nil.
+
+If you don't like the default move keys, you can change it by
+setting `ace-jump-mode-move-keys'.
+
+You can constrol whether use the case sensitive via
+`ace-jump-mode-case-fold'.
+"
+ (interactive "p")
+ (let ((index (/ prefix 4))
+ (submode-list-length (length ace-jump-mode-submode-list)))
+ (if (< index 0)
+ (error "[AceJump] Invalid prefix command"))
+ (if (>= index submode-list-length)
+ (setq index (1- submode-list-length)))
+ (call-interactively (nth index ace-jump-mode-submode-list))))
+
+(defun ace-jump-move ()
+ "move cursor based on user input"
+ (interactive)
+ (let* ((index (let ((ret (position (aref (this-command-keys) 0)
+ ace-jump-mode-move-keys)))
+ (if ret ret (length ace-jump-mode-move-keys))))
+ (node (nth index (cdr ace-jump-search-tree))))
+ (cond
+ ;; we do not find key in search tree. This can happen, for
+ ;; example, when there is only three selections in screen
+ ;; (totally five move-keys), but user press the forth move key
+ ((null node)
+ (message "No such position candidate.")
+ (ace-jump-done))
+ ;; this is a branch node, which means there need further
+ ;; selection
+ ((eq (car node) 'branch)
+ (let ((old-tree ace-jump-search-tree))
+ ;; we use sub tree in next move, create a new root node
+ ;; whose child is the sub tree nodes
+ (setq ace-jump-search-tree (cons 'branch (cdr node)))
+ (ace-jump-update-overlay-in-search-tree ace-jump-search-tree
+ ace-jump-mode-move-keys)
+
+ ;; this is important, we need remove the subtree first before
+ ;; do delete, we set the child nodes to nil
+ (setf (cdr node) nil)
+ (ace-jump-delete-overlay-in-search-tree old-tree)))
+ ;; if the node is leaf node, this is the final one
+ ((eq (car node) 'leaf)
+ ;; need to save aj data, as `ace-jump-done' will clean it
+ (let ((aj-data (overlay-get (cdr node) 'aj-data)))
+ (ace-jump-push-mark)
+ (run-hooks 'ace-jump-mode-before-jump-hook)
+ (ace-jump-jump-to aj-data))
+ (ace-jump-done)
+ (run-hooks 'ace-jump-mode-end-hook))
+ (t
+ (ace-jump-done)
+ (error "[AceJump] Internal error: tree node type is invalid")))))
+
+
+
+(defun ace-jump-done()
+ "stop AceJump motion"
+ (interactive)
+ ;; clear the status flag
+ (setq ace-jump-query-char nil)
+ (setq ace-jump-current-mode nil)
+
+ ;; clean the status line
+ (setq ace-jump-mode nil)
+ (force-mode-line-update)
+
+ ;; delete background overlay
+ (loop for ol in ace-jump-background-overlay-list
+ do (delete-overlay ol))
+ (setq ace-jump-background-overlay-list nil)
+
+
+ ;; delete overlays in search tree
+ (ace-jump-delete-overlay-in-search-tree ace-jump-search-tree)
+ (setq ace-jump-search-tree nil)
+
+ (setq overriding-local-map nil)
+
+ (remove-hook 'mouse-leave-buffer-hook 'ace-jump-done)
+ (remove-hook 'kbd-macro-termination-hook 'ace-jump-done))
+
+(defun ace-jump-kill-buffer(buffer)
+ "Utility function to kill buffer for ace jump mode.
+We also need to handle the buffer which has clients on it"
+ (if (and (boundp 'server-buffer-clients)
+ server-buffer-clients)
+ (server-buffer-done buffer t))
+ (kill-buffer buffer))
+
+;;;; ============================================
+;;;; advice to sync emacs mark ring
+;;;; ============================================
+
+(defun ace-jump-move-to-end-if ( l pred )
+ "Move all the element in a list to the end of list if it make
+the PRED to return non-nil.
+
+PRED is a function object which can pass to funcall and accept
+one argument, which will be every element in the list.
+Such as : (lambda (x) (equal x 1)) "
+ (let (true-list false-list)
+ (loop for e in l
+ do (if (funcall pred e)
+ (setq true-list (cons e true-list))
+ (setq false-list (cons e false-list))))
+ (nconc (nreverse false-list)
+ (and true-list (nreverse true-list)))))
+
+(defun ace-jump-move-first-to-end-if (l pred)
+ "Only move the first found one to the end of list"
+ (lexical-let ((pred pred)
+ found)
+ (ace-jump-move-to-end-if l
+ (lambda (x)
+ (if found
+ nil
+ (setq found (funcall pred x)))))))
+
+
+
+(defadvice pop-mark (before ace-jump-pop-mark-advice)
+ "When `pop-mark' is called to jump back, this advice will sync the mark ring.
+Move the same position to the end of `ace-jump-mode-mark-ring'."
+ (lexical-let ((mp (mark t))
+ (cb (current-buffer)))
+ (if mp
+ (setq ace-jump-mode-mark-ring
+ (ace-jump-move-first-to-end-if ace-jump-mode-mark-ring
+ (lambda (x)
+ (and (equal (aj-position-offset x) mp)
+ (eq (aj-position-buffer x) cb))))))))
+
+
+(defadvice pop-global-mark (before ace-jump-pop-global-mark-advice)
+ "When `pop-global-mark' is called to jump back, this advice will sync the mark ring.
+Move the aj-position with the same buffer to the end of `ace-jump-mode-mark-ring'."
+ (interactive)
+ ;; find the one that will be jump to
+ (let ((index global-mark-ring))
+ ;; refer to the implementation of `pop-global-mark'
+ (while (and index (not (marker-buffer (car index))))
+ (setq index (cdr index)))
+ (if index
+ ;; find the mark
+ (lexical-let ((mb (marker-buffer (car index))))
+ (setq ace-jump-mode-mark-ring
+ (ace-jump-move-to-end-if ace-jump-mode-mark-ring
+ (lambda (x)
+ (eq (aj-position-buffer x) mb))))))))
+
+
+(defun ace-jump-mode-enable-mark-sync ()
+ "Enable the sync funciton between ace jump mode mark ring and emacs mark ring.
+
+1. This function will enable the advice which activate on
+`pop-mark' and `pop-global-mark'. These advice will remove the
+same marker from `ace-jump-mode-mark-ring' when user use
+`pop-mark' or `global-pop-mark' to jump back.
+
+2. Set variable `ace-jump-sync-emacs-mark-ring' to t, which will
+sync mark information with emacs mark ring. "
+ (ad-enable-advice 'pop-mark 'before 'ace-jump-pop-mark-advice)
+ (ad-activate 'pop-mark)
+ (ad-enable-advice 'pop-global-mark 'before 'ace-jump-pop-global-mark-advice)
+ (ad-activate 'pop-global-mark)
+ (setq ace-jump-sync-emacs-mark-ring t))
+
+(defun ace-jump-mode-disable-mark-sync ()
+ "Disable the sync funciton between ace jump mode mark ring and emacs mark ring.
+
+1. This function will diable the advice which activate on
+`pop-mark' and `pop-global-mark'. These advice will remove the
+same marker from `ace-jump-mode-mark-ring' when user use
+`pop-mark' or `global-pop-mark' to jump back.
+
+2. Set variable `ace-jump-sync-emacs-mark-ring' to nil, which
+will stop synchronizing mark information with emacs mark ring. "
+ (ad-disable-advice 'pop-mark 'before 'ace-jump-pop-mark-advice)
+ (ad-activate 'pop-mark)
+ (ad-disable-advice 'pop-global-mark 'before 'ace-jump-pop-global-mark-advice)
+ (ad-activate 'pop-global-mark)
+ (setq ace-jump-sync-emacs-mark-ring nil))
+
+
+(provide 'ace-jump-mode)
+
+;;; ace-jump-mode.el ends here
+
+;; Local Variables:
+;; byte-compile-warnings: (not cl-functions)
+;; End:
--- /dev/null
+INTRODUCTION
+
+
+What's this?
+
+It is a minor mode for Emacs. It can help you to move your cursor
+to ANY position in emacs by using only 3 times key press.
+
+Where does ace jump mode come from ?
+
+I firstly see such kind of moving style is in a vim plugin called
+EasyMotion. It really attract me a lot. So I decide to write
+one for Emacs and MAKE IT BETTER.
+
+So I want to thank to :
+ Bartlomiej P. for his PreciseJump
+ Kim Silkebækken for his EasyMotion
+
+
+What's ace-jump-mode ?
+
+ace-jump-mode is an fast/direct cursor location minor mode. It will
+create the N-Branch search tree internal and marks all the possible
+position with predefined keys in within the whole emacs view.
+Allowing you to move to the character/word/line almost directly.
+
+
+Usage
+
+Add the following code to your init file, of course you can select
+the key that you prefer to.
+----------------------------------------------------------
+
+ace jump mode major function
+
+(add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/")
+(autoload
+ 'ace-jump-mode
+ "ace-jump-mode"
+ "Emacs quick move minor mode"
+ t)
+you can select the key you prefer to
+(define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
+
+
+enable a more powerful jump back function from ace jump mode
+
+(autoload
+ 'ace-jump-mode-pop-mark
+ "ace-jump-mode"
+ "Ace jump back:-)"
+ t)
+(eval-after-load "ace-jump-mode"
+ '(ace-jump-mode-enable-mark-sync))
+(define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark)
+
+If you use viper mode :
+(define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode)
+If you use evil
+(define-key evil-normal-state-map (kbd "SPC") 'ace-jump-mode)
+----------------------------------------------------------
+
+For more information
+Intro Doc: https://github.com/winterTTr/ace-jump-mode/wiki
+FAQ : https://github.com/winterTTr/ace-jump-mode/wiki/AceJump-FAQ
--- /dev/null
+;;; centered-cursor-mode-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+\f
+;;;### (autoloads (centered-cursor-mode) "centered-cursor-mode" "centered-cursor-mode.el"
+;;;;;; (21823 20143 0 0))
+;;; Generated autoloads from centered-cursor-mode.el
+
+(autoload 'centered-cursor-mode "centered-cursor-mode" "\
+Makes the cursor stay vertically in a defined
+position (usually centered).
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("centered-cursor-mode-pkg.el") (21823
+;;;;;; 20143 376262 0))
+
+;;;***
+\f
+(provide 'centered-cursor-mode-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; centered-cursor-mode-autoloads.el ends here
--- /dev/null
+(define-package "centered-cursor-mode" "20150420.1942" "cursor stays vertically centered" (quote nil))
--- /dev/null
+;;; centered-cursor-mode.el --- cursor stays vertically centered
+
+;; Copyright (C) 2007 André Riemann
+
+;; Author: André Riemann <andre.riemannNOSPAMweb.de>
+;; Maintainer: André Riemann <andre.riemannNOSPAMweb.de>
+;; Created: 2007-09-14
+;; Keywords: convenience
+;; Package-Version: 20150420.1942
+
+;; URL: http://www.emacswiki.org/emacs/centered-cursor-mode.el
+;; Compatibility: tested with GNU Emacs 23.0, 24
+;; Version: 0.5.4
+;; Last-Updated: 2015-04-20
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; Makes the cursor stay vertically in a defined position (usually
+;; centered). The vertical position can be altered, see key definition
+;; below.
+
+;; To load put that in .emacs:
+;; (require 'centered-cursor-mode)
+;; To activate do:
+;; M-x centered-cursor-mode
+;; for buffer local or
+;; M-x global-centered-cursor-mode
+;; for global minor mode.
+;; Also possible: put that in .emacs
+;; (and
+;; (require 'centered-cursor-mode)
+;; (global-centered-cursor-mode +1))
+;; to always have centered-cursor-mode on in all buffers.
+
+;;; TODO:
+;; - the code is a mess
+;; - ccm-vpos-inverted doesn't work with ccm-vpos == 0, because first
+;; position from top is 0 and from bottom -1
+;; - interactive first start isn't animated when calling global-...
+;; because it starts the modes for each buffer and interactive-p fails
+;; for that
+;; - more bugs?
+
+;;; Change Log:
+;; 2015-04-20 andre-r
+;; * corrected URL in header
+;; 2015-03-01 andre-r
+;; * fixed bug where Emacs without X support (emacs-nox) didn't find mouse-wheel-mode
+;; 2009-08-31 andre-r
+;; * replaced window-body-height with window-text-height
+;; (partially visible lines are not counted in window-text-height)
+;; * bug fixed in ccm-vpos-recenter
+;; (some parentheses where wrong after the last update)
+;; 2009-02-23 andre-r
+;; * some simplifications
+;; 2009-02-22 andre-r
+;; * some tips from Drew Adams:
+;; - new local variable coding:utf-8
+;; - made recenter-sequence a defvar
+;; - added groups scrolling and convenience
+;; - replaced mouse-4 and mouse-5 with
+;; mouse-wheel-up-event and mouse-wheel-down-event
+;; - added scroll-bar-toolkit-scroll to ccm-ignored-commands
+;; - made ccm-ignored-commands customisable
+;; * removed a bug where it didn't work with more than one window
+;; displaying the same buffer
+;; * added function for page up and down scrolling
+;; (standard ones didn't work well with this mode)
+;; * made the animation delay customisable
+;; * made the initial vertical position customisable
+;; * made the behaviour at the end of the file customisable
+;; 2008-02-02 andre-r
+;; * fixed bug that led to wrong-type-argument
+;; when opening a new buffer
+;; * some other minor stuff
+;; 2007-09-24 andre-r
+;; * added global minor mode
+;; 2007-09-21 andre-r
+;; * not recentering at end of buffer
+;; * defvar animate-first-start-p
+;; 2007-09-14 andre-r
+;; * inital release
+
+;; This file is *NOT* part of GNU Emacs.
+
+;;; Code:
+
+
+(require 'mouse-wheel-mode nil 'noerror)
+
+(defgroup centered-cursor nil
+ "Makes the cursor stay vertically in a defined position (usually centered).
+Instead the cursor the text moves around the cursor."
+ :group 'scrolling
+ :group 'convenience
+ :link '(emacs-library-link :tag "Source Lisp File" "centered-cursor-mode.el")
+ :link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/centered-cursor-mode.el"))
+
+(defcustom ccm-step-size 2
+ "Step size when animated recentering."
+ :group 'centered-cursor
+ :tag "Animation step size"
+ :type 'integer)
+
+(defcustom ccm-step-delay 0.02
+ "Delay between animation steps.
+If you want a different animation speed."
+ :group 'centered-cursor
+ :tag "Animation step delay"
+ :type 'number)
+
+(defcustom ccm-ignored-commands '(mouse-drag-region
+ mouse-set-point
+ widget-button-click
+ scroll-bar-toolkit-scroll)
+ "After these commands recentering is ignored.
+This is to prevent unintentional jumping (especially when mouse
+clicking). Following commands (except the ignored ones) will
+cause an animated recentering to give a feedback and not just
+jumping to the center."
+ :group 'centered-cursor
+ :tag "Ignored commands"
+ :type '(repeat (symbol :tag "Command")))
+
+(defcustom ccm-vpos-init '(round (window-text-height) 2)
+ "This is the screen line position where the cursor initially stays."
+ :group 'centered-cursor
+ :tag "Vertical cursor position"
+ :type '(choice (const :tag "Center" (round (window-text-height) 2))
+ (const :tag "Golden ratio" (round (* 21 (window-text-height)) 34))
+ (integer :tag "Lines from top" :value 10)))
+(make-variable-buffer-local 'ccm-vpos-init)
+
+(defcustom ccm-vpos-inverted 1
+ "Inverted vertical cursor position.
+Defines if the initial vertical position `ccm-vpos-init' is
+measured from the bottom instead from the top."
+ :group 'centered-cursor
+ :tag "Inverted cursor position"
+ :type '(choice (const :tag "Inverted" -1)
+ (const :tag "Not inverted" 1)))
+(make-variable-buffer-local 'ccm-vpos-inverted)
+
+(defcustom ccm-recenter-at-end-of-file nil
+ "Recenter at the end of the file.
+If non-nil the end of the file is recentered. If nil the end of
+the file stays at the end of the window."
+ :group 'centered-cursor
+ :tag "Recenter at EOF"
+ :type '(choice (const :tag "Don't recenter at the end of the file" nil)
+ (const :tag "Recenter at the end of the file" t)))
+(make-variable-buffer-local 'ccm-recenter-end-of-file)
+
+(defvar ccm-vpos nil
+ "This is the screen line position where the cursor stays.")
+(make-variable-buffer-local 'ccm-vpos)
+
+(defvar animate-first-start-p nil
+ "Whether or not to animate at first start. It is set to nil, if
+centered-cursor-mode is called non-interactively.")
+(make-variable-buffer-local 'animate-first-start-p)
+
+(defvar recenter-sequence nil
+ "Before animated recentering a list is generated first with positions
+to successively recenter to")
+(make-variable-buffer-local 'recenter-sequence)
+
+(defvar ccm-map
+ (let ((ccm-map (make-sparse-keymap)))
+ (define-key ccm-map [(control meta -)] 'ccm-vpos-up)
+ (define-key ccm-map [(control meta +)] 'ccm-vpos-down)
+ (define-key ccm-map [(control meta =)] 'ccm-vpos-down)
+ (define-key ccm-map [(control meta ?0)] 'ccm-vpos-recenter)
+ (when (and (boundp 'mouse-wheel-mode) mouse-wheel-mode)
+ (mapc (lambda (key)
+ (define-key ccm-map key 'ccm-mwheel-scroll))
+ (list (vector mouse-wheel-up-event)
+ (vector mouse-wheel-down-event)
+ (vector (list 'control mouse-wheel-up-event))
+ (vector (list 'control mouse-wheel-down-event))
+ (vector (list 'shift mouse-wheel-up-event))
+ (vector (list 'shift mouse-wheel-down-event)))))
+ (define-key ccm-map [(meta v)] 'ccm-scroll-down)
+ (define-key ccm-map [(control v)] 'ccm-scroll-up)
+ (define-key ccm-map [prior] 'ccm-scroll-down)
+ (define-key ccm-map [next] 'ccm-scroll-up)
+ ccm-map)
+ "Keymap used in centered-cursor-mode.")
+
+
+(defun ccm-mwheel-scroll (event)
+ "Very similar to `mwheel-scroll', but does not use `scroll-down'
+and `scroll-up' but `previous-line' and `next-line', that is, the
+cursor is moved and thus the text in the window is scrolled
+due to `recenter'.
+
+The customizable variable `mouse-wheel-scroll-amount' is used to
+determine how much to scroll, where nil instead of a number means
+the same as in mwheel-scroll, scroll by a near full screen.
+
+This command exists, because mwheel-scroll caused strange
+behaviour with automatic recentering."
+;; (interactive (list last-input-event))
+ (interactive "e")
+ (let* ((mods (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
+ (amt (assoc mods mouse-wheel-scroll-amount)))
+ ;;(message "%S" mods)
+ (if amt
+ (setq amt (or (cdr amt)
+ (- (window-text-height)
+ next-screen-context-lines)))
+ (let ((list-elt mouse-wheel-scroll-amount))
+ (while (consp (setq amt (pop list-elt))))))
+ (if mouse-wheel-follow-mouse
+ (select-window (posn-window (event-start event))))
+ (let ((button (mwheel-event-button event)))
+ (cond
+ ((eq button mouse-wheel-down-event)
+ (forward-line (- amt)))
+ ;;(princ amt))
+ ((eq button mouse-wheel-up-event)
+ (forward-line amt))
+ ;;(princ amt))
+ (t (error "Bad binding in ccm-mwheel-scroll"))))))
+
+(defun ccm-scroll-down (&optional arg)
+ "Replaces `scroll-down' because with scroll-down
+`centered-cursor-mode' sometimes doesn't reach the top of the
+buffer. This version actually moves the cursor with
+`previous-line'. Since with centered-cursor-mode the cursor is in
+a fixed position the movement appears as page up."
+ (interactive "P")
+ (let ((amt (or arg (- (window-text-height)
+ next-screen-context-lines))))
+ (forward-line (- amt))))
+
+(defun ccm-scroll-up (&optional arg)
+ "Replaces `scroll-up' to be consistent with `ccm-scroll-down'.
+This version actually moves the cursor with `previous-line'.
+Since with centered-cursor-mode the cursor is in a fixed position
+the movement appears as page up."
+ (interactive "P")
+ (let ((amt (or arg (- (window-text-height)
+ next-screen-context-lines))))
+ (forward-line amt)))
+
+
+(defun ccm-vpos-down (arg)
+ "Adjust the value of the screen line (where the cursor stays) by arg.
+Negative values for arg are possible. Just the variable ccm-vpos
+is set."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (let ((new-pos (if (< ccm-vpos 0)
+ (- ccm-vpos arg)
+ (+ ccm-vpos arg)))
+ ;; see pos-visible-in-window-p
+ (vpos-max (if (< ccm-vpos 0)
+ -1
+ (- (window-text-height) 1)))
+ (vpos-min (if (< ccm-vpos 0)
+ (- (window-text-height))
+ 0)))
+ (setq ccm-vpos
+ (cond
+ ((< new-pos vpos-min)
+ vpos-min)
+ ((> new-pos vpos-max)
+ vpos-max)
+ (t
+ new-pos)))))
+
+(defun ccm-vpos-up (arg)
+ "See `ccm-vpos-down'."
+ (interactive "p")
+ (or arg (setq arg 1))
+ (ccm-vpos-down (- arg)))
+
+(defun ccm-vpos-recenter ()
+ "Set the value of the screen line (where the cursor stays) in
+the center. Just the variable ccm-vpos is set."
+ (interactive)
+ (if (equal (current-buffer)
+ (window-buffer (selected-window)))
+ (setq ccm-vpos (* (eval ccm-vpos-init)
+ ccm-vpos-inverted))))
+
+(defun ccm-position-cursor ()
+ "Do the actual recentering at the position `ccm-vpos'."
+ (unless (member this-command ccm-ignored-commands)
+ (unless ccm-vpos
+ (ccm-vpos-recenter))
+ (unless (minibufferp (current-buffer))
+ (if (equal (current-buffer)
+ (window-buffer (selected-window)))
+ (let* ((current-line
+ (if (< ccm-vpos 0)
+ ;; one-based, from bottom, negative
+ (- (count-lines (point)
+ ;; window-end is sometimes < 0
+ ;; when opening a help buffer
+ (if (> (window-end) 0)
+ (window-end)
+ 1)))
+ ;; zero-based, from top, positive
+ (+ (count-lines (window-start) (point))
+ ;; count-lines returns different value in column 0
+ (if (= (current-column) 0) 0 -1))))
+ (diff (- ccm-vpos current-line))
+ (step-size ccm-step-size)
+ (step-delay ccm-step-delay)
+ (vpos-inverted ccm-vpos-inverted)
+ (recenter-at-end-of-file ccm-recenter-at-end-of-file))
+
+ (let* ((bottom-vpos (if (< ccm-vpos 0)
+ (- ccm-vpos)
+ (- (window-text-height) ccm-vpos)))
+ (correction (save-excursion
+ (if (or (= (point) (point-max))
+ (progn
+ (goto-char (point-max))
+ (zerop (current-column))))
+ 1 0)))
+ ;; lines from point to end of buffer
+ (bottom-lines (+ (count-lines (point) (point-max))
+ correction)))
+
+ ;; only animate if the point was moved rather far away
+ ;; before by a mouseclick (see ccm-ignored-commands)
+ ;; or if minor mode is just entered interactively
+ (if (not (and (> (abs diff) 4)
+ (or (member last-command ccm-ignored-commands)
+ animate-first-start-p)))
+
+ (recenter (if (and (< bottom-lines bottom-vpos)
+ (not recenter-at-end-of-file))
+ ;; if near the bottom, recenter in the
+ ;; negative screen line that equals the
+ ;; bottom buffer line, i.e. if we are in
+ ;; the second last line (-2) of the
+ ;; buffer, the cursor will be recentered
+ ;; in -2
+ (- bottom-lines)
+ ccm-vpos))
+
+ (setq animate-first-start-p nil)
+ ;; first build a list with positions to successively recenter to
+ (setq recenter-sequence
+ ;; reverse: because we build the list not FROM -> TO but
+ ;; TO -> FROM because if step size in number-sequence is
+ ;; bigger than one, TO might not included, that means the
+ ;; ccm-vpos would not be reached
+ ;; cdr: don't recenter the current-line
+ (if (and (< bottom-lines bottom-vpos)
+ (not recenter-at-end-of-file))
+ ;; this one is for animation near the bottom
+ (cdr (reverse (number-sequence
+ (- bottom-lines)
+ (if (< ccm-vpos 0)
+ current-line
+ (- (- (window-text-height) current-line)))
+ (* (/ diff (abs diff)) (- step-size)))))
+ (cdr (reverse (number-sequence
+ ccm-vpos
+ current-line
+ (* (/ diff (abs diff)) (- step-size)))))))
+ ;; (message "%d %d %d (%d): %S" current-line ccm-vpos bottom-lines diff recenter-sequence)
+ (while recenter-sequence
+ ;; actual animation
+ (recenter (pop recenter-sequence))
+ (if (car recenter-sequence) (sit-for step-delay t))))))))))
+
+(defun ccm-first-start (animate)
+ "Called from centered-cursor-mode. Animate at first start, if
+centered-cursor-mode is called interactively."
+ (let ((animate-first-start-p animate))
+ (ccm-vpos-recenter)
+ (ccm-position-cursor)))
+
+;;(defalias 'ccm 'centered-cursor-mode)
+;;;###autoload
+(define-minor-mode centered-cursor-mode
+ "Makes the cursor stay vertically in a defined
+position (usually centered)."
+ :init-value nil
+;; :lighter nil
+ :lighter " ¢"
+ :keymap ccm-map
+ (cond
+ (centered-cursor-mode
+ (ccm-first-start (interactive-p))
+ (add-hook 'post-command-hook 'ccm-position-cursor t t)
+ (add-hook 'window-configuration-change-hook 'ccm-vpos-recenter t t))
+ (t
+ (remove-hook 'post-command-hook 'ccm-position-cursor t)
+ (remove-hook 'window-configuration-change-hook 'ccm-vpos-recenter t))))
+
+
+(define-global-minor-mode global-centered-cursor-mode centered-cursor-mode
+ centered-cursor-mode)
+
+(provide 'centered-cursor-mode)
+
+;;; Help:
+;; (info "(elisp)Defining Minor Modes")
+;; (info "(elisp)Screen Lines")
+;; (info "(elisp)Hooks")
+;; (info "(elisp)Customization")
+;; (find-function 'mwheel-scroll)
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; centered-cursor-mode.el ends here
--- /dev/null
+Makes the cursor stay vertically in a defined position (usually
+centered). The vertical position can be altered, see key definition
+below.
+
+To load put that in .emacs:
+ (require 'centered-cursor-mode)
+To activate do:
+ M-x centered-cursor-mode
+for buffer local or
+ M-x global-centered-cursor-mode
+for global minor mode.
+Also possible: put that in .emacs
+ (and
+ (require 'centered-cursor-mode)
+ (global-centered-cursor-mode +1))
+to always have centered-cursor-mode on in all buffers.
projects / emacsconfig.git / commitdiff