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

200
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.
@ -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,16 +354,16 @@ 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))
@ -371,7 +371,7 @@ The returned value is a list of `aj-position' record."
(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
@ -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,7 +404,7 @@ 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))
@ -413,9 +413,9 @@ 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
@ -448,7 +448,7 @@ 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,
@ -457,9 +457,9 @@ node and call LEAF-FUNC on each leaf node"
;; 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
@ -471,9 +471,9 @@ node and call LEAF-FUNC on each leaf node"
;; 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)
@ -488,15 +488,15 @@ 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,
@ -508,7 +508,7 @@ node and call LEAF-FUNC on each leaf node"
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
@ -523,7 +523,7 @@ node and call LEAF-FUNC on each leaf node"
;; 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
@ -540,26 +540,26 @@ 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
@ -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,9 +598,9 @@ 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)))
@ -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
@ -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,8 +685,8 @@ 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)))
@ -702,7 +701,7 @@ 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)))
@ -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
@ -743,7 +742,7 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
;; +---+---+---+ +---+---+---+ ;; +---+---+---+ +---+---+---+
;; ;;
;; 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)
@ -753,7 +752,7 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
;; 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)
@ -895,7 +894,7 @@ 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))))
@ -923,10 +922,10 @@ 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
@ -947,7 +946,7 @@ 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,7 +980,7 @@ 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))))
@ -990,7 +989,7 @@ Such as : (lambda (x) (equal x 1)) "
(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)
@ -1003,19 +1002,19 @@ Such as : (lambda (x) (equal x 1)) "
(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,11 +1023,11 @@ 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 ()
@ -1071,4 +1070,3 @@ will stop synchronizing mark information with emacs mark ring. "
;; Local Variables: ;; Local Variables:
;; byte-compile-warnings: (not cl-functions) ;; byte-compile-warnings: (not cl-functions)
;; End: ;; End: