From de96963e2a10b6a0847c9ce9fdebcec28667e732 Mon Sep 17 00:00:00 2001 From: Wojciech Kozlowski Date: Sun, 10 Apr 2022 19:28:25 +0200 Subject: [PATCH] Add latest version of ace-jump-mode as local-repo --- repos/ace-jump-mode/README.md | 79 ++ repos/ace-jump-mode/ace-jump-mode.el | 1074 ++++++++++++++++++++++++++ 2 files changed, 1153 insertions(+) create mode 100644 repos/ace-jump-mode/README.md create mode 100644 repos/ace-jump-mode/ace-jump-mode.el diff --git a/repos/ace-jump-mode/README.md b/repos/ace-jump-mode/README.md new file mode 100644 index 0000000..1890222 --- /dev/null +++ b/repos/ace-jump-mode/README.md @@ -0,0 +1,79 @@ +Ace Jump Mode +============= + +Ace jump mode is a minor mode of emacs, which help you to move the +cursor within Emacs. You can move your cursor to **ANY** position ( +across window and frame ) in emacs by using only **3 times key +press**. Have a try and I am sure you will love it. + + +What's new in 2.0 version? +-------------------------- + +In 1.0 version, ace jump mode can only work in current window. + +However, this limitation has already been broken in 2.0 version. With +ace jump mode 2.0, you can jump to any position you wish across the +bounder of window(c-x 2/3) and even frame(c-x 5). + + +Is there a demo to show the usage? +------------------------------------ +Here is a simple one for you to learn how to use ace jump, [Demo](http://dl.dropbox.com/u/3254819/AceJumpModeDemo/AceJumpDemo.htm) + +Usage: + +"C-c SPC" ==> ace-jump-word-mode + +>enter first character of a word, select the highlighted key to move to it. + +"C-u C-c SPC" ==> ace-jump-char-mode + +>enter a character for query, select the highlighted key to move to it. + +"C-u C-u C-c SPC" ==> ace-jump-line-mode + +>each non-empty line will be marked, select the highlighted key to move to it. + +Thanks emacsrocks website, they make a great show to ace jump mode, +refer to [here](http://www.youtube.com/watch?feature=player_embedded&v=UZkpmegySnc#!). + + +How to install it? +------------------ + + ;; + ;; 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) + + +I want to know more about customized configuration? +--------------------------------------------------- +See [FAQ ](http://github.com/winterTTr/ace-jump-mode/wiki/AceJump-FAQ) diff --git a/repos/ace-jump-mode/ace-jump-mode.el b/repos/ace-jump-mode/ace-jump-mode.el new file mode 100644 index 0000000..eb464c2 --- /dev/null +++ b/repos/ace-jump-mode/ace-jump-mode.el @@ -0,0 +1,1074 @@ +;;; 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 +;; 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 . + +;;; 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: +