config/doom
config/doom
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix cl warning and other issues in ace-jump-mode

Browse Source
This commit is contained in:
Wojciech Kozlowski 2022-04-10 19:34:40 +02:00
parent de96963e2a
commit 265ac8aa8a
2 changed files with 233 additions and 235 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
repos/ace-jump-mode/README.md
View File

@ -21,7 +21,7 @@ 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) 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: Usage:
"C-c SPC" ==> ace-jump-word-mode "C-c SPC" ==> ace-jump-word-mode
@ -44,7 +44,7 @@ How to install it?
;; ;;
;; ace jump mode major function ;; ace jump mode major function
;; ;;
(add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/") (add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/")
(autoload (autoload
'ace-jump-mode 'ace-jump-mode
@ -56,7 +56,7 @@ How to install it?
;; ;;
;; enable a more powerful jump back function from ace jump mode ;; enable a more powerful jump back function from ace jump mode
;; ;;
(autoload (autoload
@ -67,7 +67,7 @@ How to install it?
(eval-after-load "ace-jump-mode" (eval-after-load "ace-jump-mode"
'(ace-jump-mode-enable-mark-sync)) '(ace-jump-mode-enable-mark-sync))
(define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark) (define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark)
;;If you use viper mode : ;;If you use viper mode :
(define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode) (define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode)
;;If you use evil ;;If you use evil

460
repos/ace-jump-mode/ace-jump-mode.el
View File

@ -1,11 +1,12 @@
;;; ace-jump-mode.el --- a quick cursor location minor mode for emacs -*- coding: utf-8-unix -*- ;;; ace-jump-mode.el --- A quick cursor location minor mode -*- coding: utf-8-unix; lexical-binding: t -*-
;; Copyright (C) 2012 Free Software Foundation, Inc. ;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author : winterTTr <winterTTr@gmail.com> ;; Author : winterTTr <winterTTr@gmail.com>
;; URL : https://github.com/winterTTr/ace-jump-mode/ ;; URL : https://github.com/winterTTr/ace-jump-mode/
;; Version : 2.0.RC ;; Version : 2.0.RC
;; Keywords : motion, location, cursor ;; Keywords : convenience, matching
;; Package-Requires: ((emacs "24.3"))
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -30,7 +31,7 @@
;; What's this? ;; What's this?
;; ;;
;; It is a minor mode for Emacs. It can help you to move your cursor ;; 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. ;; to ANY position in emacs by using only 3 times key press.
;; Where does ace jump mode come from ? ;; Where does ace jump mode come from ?
;; ;;
@ -58,7 +59,7 @@
;; ---------------------------------------------------------- ;; ----------------------------------------------------------
;; ;; ;; ;;
;; ;; ace jump mode major function ;; ;; ace jump mode major function
;; ;; ;; ;;
;; (add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/") ;; (add-to-list 'load-path "/full/path/where/ace-jump-mode.el/in/")
;; (autoload ;; (autoload
;; 'ace-jump-mode ;; 'ace-jump-mode
@ -68,7 +69,7 @@
;; ;; you can select the key you prefer to ;; ;; you can select the key you prefer to
;; (define-key global-map (kbd "C-c SPC") 'ace-jump-mode) ;; (define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
;; ;;
;; ;; ;; ;;
;; ;; enable a more powerful jump back function from ace jump mode ;; ;; enable a more powerful jump back function from ace jump mode
;; ;; ;; ;;
;; (autoload ;; (autoload
@ -79,7 +80,7 @@
;; (eval-after-load "ace-jump-mode" ;; (eval-after-load "ace-jump-mode"
;; '(ace-jump-mode-enable-mark-sync)) ;; '(ace-jump-mode-enable-mark-sync))
;; (define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark) ;; (define-key global-map (kbd "C-x SPC") 'ace-jump-mode-pop-mark)
;; ;;
;; ;;If you use viper mode : ;; ;;If you use viper mode :
;; (define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode) ;; (define-key viper-vi-global-user-map (kbd "SPC") 'ace-jump-mode)
;; ;;If you use evil ;; ;;If you use evil
@ -92,76 +93,75 @@
;;; Code: ;;; Code:
(require 'cl) (require 'cl-lib)
(require 'server)
;;;; ============================================ ;;;; ============================================
;;;; Utilities for ace-jump-mode ;;;; Utilities for ace-jump-mode
;;;; ============================================ ;;;; ============================================
;; --------------------- ;; ---------------------
;; aj-position ;; ace-jump-position
;; --------------------- ;; ---------------------
;; make a position in a visual area ;; make a position in a visual area
(defstruct aj-position offset visual-area) (cl-defstruct ace-jump-position offset visual-area)
(defmacro aj-position-buffer (aj-pos) (defmacro ace-jump-position-buffer (ace-jump-pos)
"Get the buffer object from `aj-position'." "Get the buffer object from `ace-jump-position'."
`(aj-visual-area-buffer (aj-position-visual-area ,aj-pos))) `(ace-jump-visual-area-buffer (ace-jump-position-visual-area ,ace-jump-pos)))
(defmacro aj-position-window (aj-pos) (defmacro ace-jump-position-window (ace-jump-pos)
"Get the window object from `aj-position'." "Get the window object from `ace-jump-position'."
`(aj-visual-area-window (aj-position-visual-area ,aj-pos))) `(ace-jump-visual-area-window (ace-jump-position-visual-area ,ace-jump-pos)))
(defmacro aj-position-frame (aj-pos) (defmacro ace-jump-position-frame (ace-jump-pos)
"Get the frame object from `aj-position'." "Get the frame object from `ace-jump-position'."
`(aj-visual-area-frame (aj-position-visual-area ,aj-pos))) `(ace-jump-visual-area-frame (ace-jump-position-visual-area ,ace-jump-pos)))
(defmacro aj-position-recover-buffer (aj-pos) (defmacro ace-jump-position-recover-buffer (ace-jump-pos)
"Get the recover-buffer object from `aj-position'." "Get the recover-buffer object from `ace-jump-position'."
`(aj-visual-area-recover-buffer (aj-position-visual-area ,aj-pos))) `(ace-jump-visual-area-recover-buffer (ace-jump-position-visual-area ,ace-jump-pos)))
;; --------------------- ;; ---------------------
;; aj-visual-area ;; ace-jump-visual-area
;; --------------------- ;; ---------------------
;; a record for all the possible visual area ;; a record for all the possible visual area
;; a visual area is a window that showing some buffer in some frame. ;; a visual area is a window that showing some buffer in some frame.
(defstruct aj-visual-area buffer window frame recover-buffer) (cl-defstruct ace-jump-visual-area buffer window frame recover-buffer)
;; --------------------- ;; ---------------------
;; a FIFO queue implementation ;; a FIFO queue implementation
;; --------------------- ;; ---------------------
(defstruct aj-queue head tail) (cl-defstruct ace-jump-queue head tail)
(defun aj-queue-push (item q) (defun ace-jump-queue-push (item q)
"enqueue" "enqueue"
(let ( (head (aj-queue-head q) ) (let ( (c (list item) ) )
(tail (aj-queue-tail q) )
(c (list item) ) )
(cond (cond
((null (aj-queue-head q)) ((null (ace-jump-queue-head q))
(setf (aj-queue-head q) c) (setf (ace-jump-queue-head q) c)
(setf (aj-queue-tail q) c)) (setf (ace-jump-queue-tail q) c))
(t (t
(setf (cdr (aj-queue-tail q)) c) (setf (cdr (ace-jump-queue-tail q)) c)
(setf (aj-queue-tail q) c))))) (setf (ace-jump-queue-tail q) c)))))
(defun aj-queue-pop (q) (defun ace-jump-queue-pop (q)
"dequeue" "dequeue"
(if (null (aj-queue-head q)) (if (null (ace-jump-queue-head q))
(error "[AceJump] Interal Error: Empty queue")) (error "[AceJump] Interal Error: Empty queue"))
(let ((ret (aj-queue-head q))) (let ((ret (ace-jump-queue-head q)))
(if (eq ret (aj-queue-tail q)) (if (eq ret (ace-jump-queue-tail q))
;; only one item left ;; only one item left
(progn (progn
(setf (aj-queue-head q) nil) (setf (ace-jump-queue-head q) nil)
(setf (aj-queue-tail q) nil)) (setf (ace-jump-queue-tail q) nil))
;; multi item left, move forward the head ;; multi item left, move forward the head
(setf (aj-queue-head q) (cdr ret))) (setf (ace-jump-queue-head q) (cdr ret)))
(car ret))) (car ret)))
@ -240,8 +240,8 @@ Currently, the valid submode is:
") ")
(defvar ace-jump-mode-move-keys (defvar ace-jump-mode-move-keys
(nconc (loop for i from ?a to ?z collect i) (nconc (cl-loop for i from ?a to ?z collect i)
(loop for i from ?A to ?Z collect i)) (cl-loop for i from ?A to ?Z collect i))
"*The keys that used to move when enter AceJump mode. "*The keys that used to move when enter AceJump mode.
Each key should only an printable character, whose name will Each key should only an printable character, whose name will
fill each possible location. fill each possible location.
@ -354,32 +354,32 @@ 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'. You can control whether use the case sensitive or not by `ace-jump-mode-case-fold'.
Every possible `match-beginning' will be collected. Every possible `match-beginning' will be collected.
The returned value is a list of `aj-position' record." The returned value is a list of `ace-jump-position' record."
(loop for va in visual-area-list (cl-loop for va in visual-area-list
append (let* ((current-window (aj-visual-area-window va)) append (let* ((current-window (ace-jump-visual-area-window va))
(start-point (window-start current-window)) (start-point (window-start current-window))
(end-point (window-end current-window t))) (end-point (window-end current-window t)))
(with-selected-window current-window (with-selected-window current-window
(save-excursion (save-excursion
(goto-char start-point) (goto-char start-point)
(let ((case-fold-search ace-jump-mode-case-fold)) (let ((case-fold-search ace-jump-mode-case-fold))
(loop while (re-search-forward re-query-string nil t) (cl-loop while (re-search-forward re-query-string nil t)
until (or until (or
(> (point) end-point) (> (point) end-point)
(eobp)) (eobp))
if (and (or ace-jump-allow-invisible (not (invisible-p (match-beginning 0)))) if (and (or ace-jump-allow-invisible (not (invisible-p (match-beginning 0))))
(or (null ace-jump-search-filter) (or (null ace-jump-search-filter)
(ignore-errors (ignore-errors
(funcall ace-jump-search-filter)))) (funcall ace-jump-search-filter))))
collect (make-aj-position :offset (match-beginning 0) collect (make-ace-jump-position :offset (match-beginning 0)
:visual-area va) :visual-area va)
;; when we use "^" to search line mode, ;; when we use "^" to search line mode,
;; re-search-backward will not move one ;; re-search-backward will not move one
;; char after search success, as line ;; char after search success, as line
;; begin is not a valid visible char. ;; begin is not a valid visible char.
;; We need to help it to move forward. ;; We need to help it to move forward.
do (if (string-equal re-query-string "^") do (if (string-equal re-query-string "^")
(goto-char (1+ (match-beginning 0))))))))))) (goto-char (1+ (match-beginning 0)))))))))))
(defun ace-jump-tree-breadth-first-construct (total-leaf-node max-child-node) (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. "Constrct the search tree, each item in the tree is a cons cell.
@ -387,14 +387,14 @@ 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, The (cdr tree-node) is data stored in a leaf when type is 'leaf,
while a child node list when type is 'branch" while a child node list when type is 'branch"
(let ((left-leaf-node (- total-leaf-node 1)) (let ((left-leaf-node (- total-leaf-node 1))
(q (make-aj-queue)) (q (make-ace-jump-queue))
(node nil) (node nil)
(root (cons 'leaf nil)) ) (root (cons 'leaf nil)) )
;; we push the node into queue and make candidate-sum -1, so ;; we push the node into queue and make candidate-sum -1, so
;; create the start condition for the while loop ;; create the start condition for the while loop
(aj-queue-push root q) (ace-jump-queue-push root q)
(while (> left-leaf-node 0) (while (> left-leaf-node 0)
(setq node (aj-queue-pop q)) (setq node (ace-jump-queue-pop q))
;; when a node is picked up from stack, it will be changed to a ;; when a node is picked up from stack, it will be changed to a
;; branch node, we lose a leaft node ;; branch node, we lose a leaft node
(setf (car node) 'branch) (setf (car node) 'branch)
@ -404,8 +404,8 @@ while a child node list when type is 'branch"
;; current child can fill the left leaf ;; current child can fill the left leaf
(progn (progn
(setf (cdr node) (setf (cdr node)
(loop for i from 1 to left-leaf-node (cl-loop for i from 1 to left-leaf-node
collect (cons 'leaf nil))) collect (cons 'leaf nil)))
;; so this should be the last action for while ;; so this should be the last action for while
(setq left-leaf-node 0)) (setq left-leaf-node 0))
;; the child can not cover the left leaf ;; the child can not cover the left leaf
@ -413,10 +413,10 @@ while a child node list when type is 'branch"
;; fill as much as possible. Push them to queue, so it have ;; fill as much as possible. Push them to queue, so it have
;; the oppotunity to become 'branch node if necessary ;; the oppotunity to become 'branch node if necessary
(setf (cdr node) (setf (cdr node)
(loop for i from 1 to max-child-node (cl-loop for i from 1 to max-child-node
collect (let ((n (cons 'leaf nil))) collect (let ((n (cons 'leaf nil)))
(aj-queue-push n q) (ace-jump-queue-push n q)
n))) n)))
(setq left-leaf-node (- left-leaf-node max-child-node))))) (setq left-leaf-node (- left-leaf-node max-child-node)))))
;; return the root node ;; return the root node
root)) root))
@ -447,35 +447,35 @@ node and call LEAF-FUNC on each leaf node"
(defun ace-jump-populate-overlay-to-search-tree (tree candidate-list) (defun ace-jump-populate-overlay-to-search-tree (tree candidate-list)
"Populate the overlay to search tree, every leaf will give one overlay" "Populate the overlay to search tree, every leaf will give one overlay"
(lexical-let* (;; create the locally dynamic variable for the following function (let* (;; create the locally dynamic variable for the following function
(position-list candidate-list) (position-list candidate-list)
;; make the function to create overlay for each leaf node, ;; make the function to create overlay for each leaf node,
;; here we only create each overlay for each candidate ;; here we only create each overlay for each candidate
;; position, , but leave the 'display property to be empty, ;; position, , but leave the 'display property to be empty,
;; which will be fill in "update-overlay" function ;; which will be fill in "update-overlay" function
(func-create-overlay (lambda (node) (func-create-overlay (lambda (node)
(let* ((p (car position-list)) (let* ((p (car position-list))
(o (aj-position-offset p)) (o (ace-jump-position-offset p))
(w (aj-position-window p)) (w (ace-jump-position-window p))
(b (aj-position-buffer p)) (b (ace-jump-position-buffer p))
;; create one char overlay ;; create one char overlay
(ol (make-overlay o (1+ o) b))) (ol (make-overlay o (1+ o) b)))
;; update leaf node to remember the ol ;; update leaf node to remember the ol
(setf (cdr node) ol) (setf (cdr node) ol)
(overlay-put ol 'face 'ace-jump-face-foreground) (overlay-put ol 'face 'ace-jump-face-foreground)
;; this is important, because sometimes the different ;; this is important, because sometimes the different
;; window may dispaly the same buffer, in that case, ;; window may dispaly the same buffer, in that case,
;; overlay for different window (but the same buffer) ;; overlay for different window (but the same buffer)
;; will show at the same time on both window ;; will show at the same time on both window
;; So we make it only on the specific window ;; So we make it only on the specific window
(overlay-put ol 'window w) (overlay-put ol 'window w)
;; associate the aj-position data with overlay ;; associate the ace-jump-position data with overlay
;; so that we can use it to do the final jump ;; so that we can use it to do the final jump
(overlay-put ol 'aj-data p) (overlay-put ol 'ace-jump-data p)
;; next candidate node ;; next candidate node
(setq position-list (cdr position-list)))))) (setq position-list (cdr position-list))))))
(ace-jump-tree-preorder-traverse tree func-create-overlay) (ace-jump-tree-preorder-traverse tree func-create-overlay)
tree)) tree))
@ -488,51 +488,51 @@ node and call LEAF-FUNC on each leaf node"
(ace-jump-tree-preorder-traverse tree func-delete-overlay))) (ace-jump-tree-preorder-traverse tree func-delete-overlay)))
(defun ace-jump-buffer-substring (pos) (defun ace-jump-buffer-substring (pos)
"Get the char under the POS, which is aj-position structure." "Get the char under the POS, which is ace-jump-position structure."
(let* ((w (aj-position-window pos)) (let* ((w (ace-jump-position-window pos))
(offset (aj-position-offset pos))) (offset (ace-jump-position-offset pos)))
(with-selected-window w (with-selected-window w
(buffer-substring offset (1+ offset))))) (buffer-substring offset (1+ offset)))))
(defun ace-jump-update-overlay-in-search-tree (tree keys) (defun ace-jump-update-overlay-in-search-tree (tree keys)
"Update overlay 'display property using each name in keys" "Update overlay 'display property using each name in keys"
(lexical-let* (;; create dynamic variable for following function (let* (;; create dynamic variable for following function
(key ?\0) (key ?\0)
;; populdate each leaf node to be the specific key, ;; populdate each leaf node to be the specific key,
;; this only update 'display' property of overlay, ;; this only update 'display' property of overlay,
;; so that user can see the key from screen and select ;; so that user can see the key from screen and select
(func-update-overlay (func-update-overlay
(lambda (node) (lambda (node)
(let ((ol (cdr node))) (let ((ol (cdr node)))
(overlay-put (overlay-put
ol ol
'display 'display
(concat (make-string 1 key) (concat (make-string 1 key)
(let* ((pos (overlay-get ol 'aj-data)) (let* ((pos (overlay-get ol 'ace-jump-data))
(subs (ace-jump-buffer-substring pos))) (subs (ace-jump-buffer-substring pos)))
(cond (cond
;; when tab, we use more space to prevent screen ;; when tab, we use more space to prevent screen
;; from messing up ;; from messing up
((string-equal subs "\t") ((string-equal subs "\t")
(make-string (1- tab-width) ? )) (make-string (1- tab-width) ? ))
;; when enter, we need to add one more enter ;; when enter, we need to add one more enter
;; to make the screen not change ;; to make the screen not change
((string-equal subs "\n") ((string-equal subs "\n")
"\n") "\n")
(t (t
;; there are wide-width characters ;; there are wide-width characters
;; so, we need paddings ;; so, we need paddings
(make-string (max 0 (1- (string-width subs))) ? )))))))))) (make-string (max 0 (1- (string-width subs))) ? ))))))))))
(loop for k in keys (cl-loop for k in keys
for n in (cdr tree) for n in (cdr tree)
do (progn do (progn
;; update "key" variable so that the function can use ;; update "key" variable so that the function can use
;; the correct context ;; the correct context
(setq key k) (setq key k)
(if (eq (car n) 'branch) (if (eq (car n) 'branch)
(ace-jump-tree-preorder-traverse n (ace-jump-tree-preorder-traverse n
func-update-overlay) func-update-overlay)
(funcall func-update-overlay n)))))) (funcall func-update-overlay n))))))
@ -540,28 +540,28 @@ node and call LEAF-FUNC on each leaf node"
"Based on `ace-jump-mode-scope', search the possible buffers that is showing now." "Based on `ace-jump-mode-scope', search the possible buffers that is showing now."
(cond (cond
((eq ace-jump-mode-scope 'global) ((eq ace-jump-mode-scope 'global)
(loop for f in (frame-list) (cl-loop for f in (frame-list)
append (loop for w in (window-list f) append (cl-loop for w in (window-list f)
collect (make-aj-visual-area :buffer (window-buffer w) collect (make-ace-jump-visual-area :buffer (window-buffer w)
:window w :window w
:frame f)))) :frame f))))
((eq ace-jump-mode-scope 'visible) ((eq ace-jump-mode-scope 'visible)
(loop for f in (frame-list) (cl-loop for f in (frame-list)
if (eq t (frame-visible-p f)) if (eq t (frame-visible-p f))
append (loop for w in (window-list f) append (cl-loop for w in (window-list f)
collect (make-aj-visual-area :buffer (window-buffer w) collect (make-ace-jump-visual-area :buffer (window-buffer w)
:window w :window w
:frame f)))) :frame f))))
((eq ace-jump-mode-scope 'frame) ((eq ace-jump-mode-scope 'frame)
(loop for w in (window-list (selected-frame)) (cl-loop for w in (window-list (selected-frame))
collect (make-aj-visual-area :buffer (window-buffer w) collect (make-ace-jump-visual-area :buffer (window-buffer w)
:window w :window w
:frame (selected-frame)))) :frame (selected-frame))))
((eq ace-jump-mode-scope 'window) ((eq ace-jump-mode-scope 'window)
(list (list
(make-aj-visual-area :buffer (current-buffer) (make-ace-jump-visual-area :buffer (current-buffer)
:window (selected-window) :window (selected-window)
:frame (selected-frame)))) :frame (selected-frame))))
(t (t
(error "[AceJump] Invalid ace-jump-mode-scope, please check your configuration")))) (error "[AceJump] Invalid ace-jump-mode-scope, please check your configuration"))))
@ -576,7 +576,7 @@ 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 ;; we check the move key to make it valid, cause it can be customized by user
(if (or (null ace-jump-mode-move-keys) (if (or (null ace-jump-mode-move-keys)
(< (length ace-jump-mode-move-keys) 2) (< (length ace-jump-mode-move-keys) 2)
(not (every #'characterp ace-jump-mode-move-keys))) (not (cl-every #'characterp ace-jump-mode-move-keys)))
(error "[AceJump] Invalid move keys: check ace-jump-mode-move-keys")) (error "[AceJump] Invalid move keys: check ace-jump-mode-move-keys"))
;; search candidate position ;; search candidate position
(let* ((visual-area-list (ace-jump-list-visual-area)) (let* ((visual-area-list (ace-jump-list-visual-area))
@ -598,14 +598,14 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
;; create background for each visual area ;; create background for each visual area
(if ace-jump-mode-gray-background (if ace-jump-mode-gray-background
(setq ace-jump-background-overlay-list (setq ace-jump-background-overlay-list
(loop for va in visual-area-list (cl-loop for va in visual-area-list
collect (let* ((w (aj-visual-area-window va)) collect (let* ((w (ace-jump-visual-area-window va))
(b (aj-visual-area-buffer va)) (b (ace-jump-visual-area-buffer va))
(ol (make-overlay (window-start w) (ol (make-overlay (window-start w)
(window-end w) (window-end w)
b))) b)))
(overlay-put ol 'face 'ace-jump-face-background) (overlay-put ol 'face 'ace-jump-face-background)
ol)))) ol))))
;; construct search tree and populate overlay into tree ;; construct search tree and populate overlay into tree
(setq ace-jump-search-tree (setq ace-jump-search-tree
@ -643,11 +643,11 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
(defun ace-jump-jump-to (position) (defun ace-jump-jump-to (position)
"Jump to the POSITION, which is a `aj-position' structure storing the position information" "Jump to the POSITION, which is a `ace-jump-position' structure storing the position information"
(let ((offset (aj-position-offset position)) (let ((offset (ace-jump-position-offset position))
(frame (aj-position-frame position)) (frame (ace-jump-position-frame position))
(window (aj-position-window position)) (window (ace-jump-position-window position))
(buffer (aj-position-buffer position)) (buffer (ace-jump-position-buffer position))
(line-mode-column 0)) (line-mode-column 0))
;; save the column before do line jump, so that we can jump to the ;; save the column before do line jump, so that we can jump to the
@ -659,7 +659,7 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
(if (and (frame-live-p frame) (if (and (frame-live-p frame)
(not (eq frame (selected-frame)))) (not (eq frame (selected-frame))))
(select-frame-set-input-focus (window-frame window))) (select-frame-set-input-focus (window-frame window)))
;; select the correct window ;; select the correct window
(if (and (window-live-p window) (if (and (window-live-p window)
(not (eq window (selected-window)))) (not (eq window (selected-window))))
@ -677,8 +677,7 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
;; recover to the same column if we use the line jump mode ;; recover to the same column if we use the line jump mode
(if (eq ace-jump-current-mode 'ace-jump-line-mode) (if (eq ace-jump-current-mode 'ace-jump-line-mode)
(move-to-column line-mode-column)) (move-to-column line-mode-column))))
))
(defun ace-jump-push-mark () (defun ace-jump-push-mark ()
"Push the current position information onto the `ace-jump-mode-mark-ring'." "Push the current position information onto the `ace-jump-mode-mark-ring'."
@ -686,10 +685,10 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
(push-mark (point) t) (push-mark (point) t)
;; we also push the mark on the `ace-jump-mode-mark-ring', which has ;; we also push the mark on the `ace-jump-mode-mark-ring', which has
;; more information for better jump back ;; more information for better jump back
(let ((pos (make-aj-position :offset (point) (let ((pos (make-ace-jump-position :offset (point)
:visual-area (make-aj-visual-area :buffer (current-buffer) :visual-area (make-ace-jump-visual-area :buffer (current-buffer)
:window (selected-window) :window (selected-window)
:frame (selected-frame))))) :frame (selected-frame)))))
(setq ace-jump-mode-mark-ring (cons pos ace-jump-mode-mark-ring))) (setq ace-jump-mode-mark-ring (cons pos ace-jump-mode-mark-ring)))
;; when exeed the max count, discard the last one ;; when exeed the max count, discard the last one
(if (> (length ace-jump-mode-mark-ring) ace-jump-mode-mark-ring-max) (if (> (length ace-jump-mode-mark-ring) ace-jump-mode-mark-ring-max)
@ -702,10 +701,10 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
(interactive) (interactive)
;; we jump over the killed buffer position ;; we jump over the killed buffer position
(while (and ace-jump-mode-mark-ring (while (and ace-jump-mode-mark-ring
(not (buffer-live-p (aj-position-buffer (not (buffer-live-p (ace-jump-position-buffer
(car ace-jump-mode-mark-ring))))) (car ace-jump-mode-mark-ring)))))
(setq ace-jump-mode-mark-ring (cdr ace-jump-mode-mark-ring))) (setq ace-jump-mode-mark-ring (cdr ace-jump-mode-mark-ring)))
(if (null ace-jump-mode-mark-ring) (if (null ace-jump-mode-mark-ring)
;; no valid history exist ;; no valid history exist
(error "[AceJump] No more history")) (error "[AceJump] No more history"))
@ -714,8 +713,8 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
(let ((p (car ace-jump-mode-mark-ring))) (let ((p (car ace-jump-mode-mark-ring)))
;; if we are jump back in the current buffer, that means we ;; if we are jump back in the current buffer, that means we
;; only need to sync the buffer local mark-ring ;; only need to sync the buffer local mark-ring
(if (eq (current-buffer) (aj-position-buffer p)) (if (eq (current-buffer) (ace-jump-position-buffer p))
(if (equal (aj-position-offset p) (marker-position (mark-marker))) (if (equal (ace-jump-position-offset p) (marker-position (mark-marker)))
;; if the current marker is the same as where we need ;; if the current marker is the same as where we need
;; to jump back, we do the same as pop-mark actually, ;; to jump back, we do the same as pop-mark actually,
;; copy implementation from pop-mark, cannot use it ;; copy implementation from pop-mark, cannot use it
@ -726,9 +725,9 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
(move-marker (car mark-ring) nil) (move-marker (car mark-ring) nil)
(setq mark-ring (cdr mark-ring)) (setq mark-ring (cdr mark-ring))
(deactivate-mark)) (deactivate-mark))
;; But if there is other marker put before the wanted destination, the following scenario ;; But if there is other marker put before the wanted destination, the following scenario
;; ;;
;; +---+---+---+---+ +---+---+---+---+ ;; +---+---+---+---+ +---+---+---+---+
;; Mark Ring | 2 | 3 | 4 | 5 | | 2 | 4 | 5 | 3 | ;; Mark Ring | 2 | 3 | 4 | 5 | | 2 | 4 | 5 | 3 |
;; +---+---+---+---+ +---+---+---+---+ ;; +---+---+---+---+ +---+---+---+---+
@ -738,28 +737,28 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
;; +---+ +---+ ;; +---+ +---+
;; Cursor | X | Pop up AJ mark 3 | 3 | <-- Cursor position ;; Cursor | X | Pop up AJ mark 3 | 3 | <-- Cursor position
;; +---+ +---+ ;; +---+ +---+
;; +---+---+---+ +---+---+---+ ;; +---+---+---+ +---+---+---+
;; AJ Ring | 3 | 4 | 5 | | 4 | 5 | 3 | ;; 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 ;; So what we need to do, is put the found mark in mark-ring to the end
(lexical-let ((po (aj-position-offset p))) (let ((po (ace-jump-position-offset p)))
(setq mark-ring (setq mark-ring
(ace-jump-move-first-to-end-if mark-ring (ace-jump-move-first-to-end-if mark-ring
(lambda (x) (lambda (x)
(equal (marker-position x) po)))))) (equal (marker-position x) po))))))
;; when we jump back to another buffer, do as the ;; when we jump back to another buffer, do as the
;; pop-global-mark does. But we move the marker with the ;; pop-global-mark does. But we move the marker with the
;; same target buffer to the end, not always the first one ;; same target buffer to the end, not always the first one
(lexical-let ((pb (aj-position-buffer p))) (let ((pb (ace-jump-position-buffer p)))
(setq global-mark-ring (setq global-mark-ring
(ace-jump-move-first-to-end-if global-mark-ring (ace-jump-move-first-to-end-if global-mark-ring
(lambda (x) (lambda (x)
(eq (marker-buffer x) pb)))))))) (eq (marker-buffer x) pb))))))))
;; move the first element to the end of the ring ;; move the first element to the end of the ring
(ace-jump-jump-to (car ace-jump-mode-mark-ring)) (ace-jump-jump-to (car ace-jump-mode-mark-ring))
(setq ace-jump-mode-mark-ring (nconc (cdr ace-jump-mode-mark-ring) (setq ace-jump-mode-mark-ring (nconc (cdr ace-jump-mode-mark-ring)
@ -800,9 +799,9 @@ word-mode and char-mode"
;; when you trigger the key for ace jump again when already in ace ;; when you trigger the key for ace jump again when already in ace
;; jump mode. So we stop the previous one first. ;; jump mode. So we stop the previous one first.
(if ace-jump-current-mode (ace-jump-done)) (if ace-jump-current-mode (ace-jump-done))
(if (eq (ace-jump-char-category query-char) 'other) (if (eq (ace-jump-char-category query-char) 'other)
(error "[AceJump] Non-printable character")) (error "[AceJump] Non-printable character"))
;; others : digit , alpha, punc ;; others : digit , alpha, punc
(setq ace-jump-query-char query-char) (setq ace-jump-query-char query-char)
@ -858,7 +857,7 @@ Marked each no empty line and move there"
;; when you trigger the key for ace jump again when already in ace ;; when you trigger the key for ace jump again when already in ace
;; jump mode. So we stop the previous one first. ;; jump mode. So we stop the previous one first.
(if ace-jump-current-mode (ace-jump-done)) (if ace-jump-current-mode (ace-jump-done))
(setq ace-jump-current-mode 'ace-jump-line-mode) (setq ace-jump-current-mode 'ace-jump-line-mode)
(ace-jump-do "^")) (ace-jump-do "^"))
@ -895,8 +894,8 @@ You can constrol whether use the case sensitive via
(defun ace-jump-move () (defun ace-jump-move ()
"move cursor based on user input" "move cursor based on user input"
(interactive) (interactive)
(let* ((index (let ((ret (position (aref (this-command-keys) 0) (let* ((index (let ((ret (cl-position (aref (this-command-keys) 0)
ace-jump-mode-move-keys))) ace-jump-mode-move-keys)))
(if ret ret (length ace-jump-mode-move-keys)))) (if ret ret (length ace-jump-mode-move-keys))))
(node (nth index (cdr ace-jump-search-tree)))) (node (nth index (cdr ace-jump-search-tree))))
(cond (cond
@ -923,11 +922,11 @@ You can constrol whether use the case sensitive via
;; if the node is leaf node, this is the final one ;; if the node is leaf node, this is the final one
((eq (car node) 'leaf) ((eq (car node) 'leaf)
;; need to save aj data, as `ace-jump-done' will clean it ;; need to save aj data, as `ace-jump-done' will clean it
(let ((aj-data (overlay-get (cdr node) 'aj-data))) (let ((ace-jump-data (overlay-get (cdr node) 'ace-jump-data)))
(ace-jump-push-mark) (ace-jump-push-mark)
(run-hooks 'ace-jump-mode-before-jump-hook) (run-hooks 'ace-jump-mode-before-jump-hook)
(ace-jump-jump-to aj-data)) (ace-jump-jump-to ace-jump-data))
(ace-jump-done) (ace-jump-done)
(run-hooks 'ace-jump-mode-end-hook)) (run-hooks 'ace-jump-mode-end-hook))
(t (t
(ace-jump-done) (ace-jump-done)
@ -947,8 +946,8 @@ You can constrol whether use the case sensitive via
(force-mode-line-update) (force-mode-line-update)
;; delete background overlay ;; delete background overlay
(loop for ol in ace-jump-background-overlay-list (cl-loop for ol in ace-jump-background-overlay-list
do (delete-overlay ol)) do (delete-overlay ol))
(setq ace-jump-background-overlay-list nil) (setq ace-jump-background-overlay-list nil)
@ -981,41 +980,41 @@ PRED is a function object which can pass to funcall and accept
one argument, which will be every element in the list. one argument, which will be every element in the list.
Such as : (lambda (x) (equal x 1)) " Such as : (lambda (x) (equal x 1)) "
(let (true-list false-list) (let (true-list false-list)
(loop for e in l (cl-loop for e in l
do (if (funcall pred e) do (if (funcall pred e)
(setq true-list (cons e true-list)) (setq true-list (cons e true-list))
(setq false-list (cons e false-list)))) (setq false-list (cons e false-list))))
(nconc (nreverse false-list) (nconc (nreverse false-list)
(and true-list (nreverse true-list))))) (and true-list (nreverse true-list)))))
(defun ace-jump-move-first-to-end-if (l pred) (defun ace-jump-move-first-to-end-if (l pred)
"Only move the first found one to the end of list" "Only move the first found one to the end of list"
(lexical-let ((pred pred) (let ((pred pred)
found) found)
(ace-jump-move-to-end-if l (ace-jump-move-to-end-if l
(lambda (x) (lambda (x)
(if found (if found
nil nil
(setq found (funcall pred x))))))) (setq found (funcall pred x)))))))
(defadvice pop-mark (before ace-jump-pop-mark-advice) (defadvice pop-mark (before ace-jump-pop-mark-advice)
"When `pop-mark' is called to jump back, this advice will sync the mark ring. "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'." Move the same position to the end of `ace-jump-mode-mark-ring'."
(lexical-let ((mp (mark t)) (let ((mp (mark t))
(cb (current-buffer))) (cb (current-buffer)))
(if mp (if mp
(setq ace-jump-mode-mark-ring (setq ace-jump-mode-mark-ring
(ace-jump-move-first-to-end-if ace-jump-mode-mark-ring (ace-jump-move-first-to-end-if ace-jump-mode-mark-ring
(lambda (x) (lambda (x)
(and (equal (aj-position-offset x) mp) (and (equal (ace-jump-position-offset x) mp)
(eq (aj-position-buffer x) cb)))))))) (eq (ace-jump-position-buffer x) cb))))))))
(defadvice pop-global-mark (before ace-jump-pop-global-mark-advice) (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. "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'." Move the ace-jump-position with the same buffer to the end of `ace-jump-mode-mark-ring'."
(interactive) (interactive)
;; find the one that will be jump to ;; find the one that will be jump to
(let ((index global-mark-ring)) (let ((index global-mark-ring))
@ -1024,12 +1023,12 @@ Move the aj-position with the same buffer to the end of `ace-jump-mode-mark-ring
(setq index (cdr index))) (setq index (cdr index)))
(if index (if index
;; find the mark ;; find the mark
(lexical-let ((mb (marker-buffer (car index)))) (let ((mb (marker-buffer (car index))))
(setq ace-jump-mode-mark-ring (setq ace-jump-mode-mark-ring
(ace-jump-move-to-end-if ace-jump-mode-mark-ring (ace-jump-move-to-end-if ace-jump-mode-mark-ring
(lambda (x) (lambda (x)
(eq (aj-position-buffer x) mb)))))))) (eq (ace-jump-position-buffer x) mb))))))))
(defun ace-jump-mode-enable-mark-sync () (defun ace-jump-mode-enable-mark-sync ()
"Enable the sync funciton between ace jump mode mark ring and emacs mark ring. "Enable the sync funciton between ace jump mode mark ring and emacs mark ring.
@ -1037,7 +1036,7 @@ Move the aj-position with the same buffer to the end of `ace-jump-mode-mark-ring
1. This function will enable the advice which activate on 1. This function will enable the advice which activate on
`pop-mark' and `pop-global-mark'. These advice will remove the `pop-mark' and `pop-global-mark'. These advice will remove the
same marker from `ace-jump-mode-mark-ring' when user use same marker from `ace-jump-mode-mark-ring' when user use
`pop-mark' or `global-pop-mark' to jump back. `pop-mark' or `global-pop-mark' to jump back.
2. Set variable `ace-jump-sync-emacs-mark-ring' to t, which will 2. Set variable `ace-jump-sync-emacs-mark-ring' to t, which will
sync mark information with emacs mark ring. " sync mark information with emacs mark ring. "
@ -1053,7 +1052,7 @@ sync mark information with emacs mark ring. "
1. This function will diable the advice which activate on 1. This function will diable the advice which activate on
`pop-mark' and `pop-global-mark'. These advice will remove the `pop-mark' and `pop-global-mark'. These advice will remove the
same marker from `ace-jump-mode-mark-ring' when user use same marker from `ace-jump-mode-mark-ring' when user use
`pop-mark' or `global-pop-mark' to jump back. `pop-mark' or `global-pop-mark' to jump back.
2. Set variable `ace-jump-sync-emacs-mark-ring' to nil, which 2. Set variable `ace-jump-sync-emacs-mark-ring' to nil, which
will stop synchronizing mark information with emacs mark ring. " will stop synchronizing mark information with emacs mark ring. "
@ -1068,7 +1067,6 @@ will stop synchronizing mark information with emacs mark ring. "
;;; ace-jump-mode.el ends here ;;; ace-jump-mode.el ends here
;; Local Variables: ;; Local Variables:
;; byte-compile-warnings: (not cl-functions) ;; byte-compile-warnings: (not cl-functions)
;; End: ;; End: