Fix cl warning and other issues in ace-jump-mode
This commit is contained in:
parent
de96963e2a
commit
265ac8aa8a
@ -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.
|
||||
|
||||
;; Author : winterTTr <winterTTr@gmail.com>
|
||||
;; URL : https://github.com/winterTTr/ace-jump-mode/
|
||||
;; Version : 2.0.RC
|
||||
;; Keywords : motion, location, cursor
|
||||
;; Keywords : convenience, matching
|
||||
;; Package-Requires: ((emacs "24.3"))
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
@ -92,76 +93,75 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
(require 'cl-lib)
|
||||
(require 'server)
|
||||
|
||||
;;;; ============================================
|
||||
;;;; Utilities for ace-jump-mode
|
||||
;;;; ============================================
|
||||
|
||||
;; ---------------------
|
||||
;; aj-position
|
||||
;; ace-jump-position
|
||||
;; ---------------------
|
||||
|
||||
;; 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)
|
||||
"Get the buffer object from `aj-position'."
|
||||
`(aj-visual-area-buffer (aj-position-visual-area ,aj-pos)))
|
||||
(defmacro ace-jump-position-buffer (ace-jump-pos)
|
||||
"Get the buffer object from `ace-jump-position'."
|
||||
`(ace-jump-visual-area-buffer (ace-jump-position-visual-area ,ace-jump-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 ace-jump-position-window (ace-jump-pos)
|
||||
"Get the window object from `ace-jump-position'."
|
||||
`(ace-jump-visual-area-window (ace-jump-position-visual-area ,ace-jump-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 ace-jump-position-frame (ace-jump-pos)
|
||||
"Get the frame object from `ace-jump-position'."
|
||||
`(ace-jump-visual-area-frame (ace-jump-position-visual-area ,ace-jump-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)))
|
||||
(defmacro ace-jump-position-recover-buffer (ace-jump-pos)
|
||||
"Get the recover-buffer object from `ace-jump-position'."
|
||||
`(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 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
|
||||
;; ---------------------
|
||||
(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"
|
||||
(let ( (head (aj-queue-head q) )
|
||||
(tail (aj-queue-tail q) )
|
||||
(c (list item) ) )
|
||||
(let ( (c (list item) ) )
|
||||
(cond
|
||||
((null (aj-queue-head q))
|
||||
(setf (aj-queue-head q) c)
|
||||
(setf (aj-queue-tail q) c))
|
||||
((null (ace-jump-queue-head q))
|
||||
(setf (ace-jump-queue-head q) c)
|
||||
(setf (ace-jump-queue-tail q) c))
|
||||
(t
|
||||
(setf (cdr (aj-queue-tail q)) c)
|
||||
(setf (aj-queue-tail q) c)))))
|
||||
(setf (cdr (ace-jump-queue-tail q)) c)
|
||||
(setf (ace-jump-queue-tail q) c)))))
|
||||
|
||||
(defun aj-queue-pop (q)
|
||||
(defun ace-jump-queue-pop (q)
|
||||
"dequeue"
|
||||
(if (null (aj-queue-head q))
|
||||
(if (null (ace-jump-queue-head q))
|
||||
(error "[AceJump] Interal Error: Empty queue"))
|
||||
|
||||
(let ((ret (aj-queue-head q)))
|
||||
(if (eq ret (aj-queue-tail q))
|
||||
(let ((ret (ace-jump-queue-head q)))
|
||||
(if (eq ret (ace-jump-queue-tail q))
|
||||
;; only one item left
|
||||
(progn
|
||||
(setf (aj-queue-head q) nil)
|
||||
(setf (aj-queue-tail q) nil))
|
||||
(setf (ace-jump-queue-head q) nil)
|
||||
(setf (ace-jump-queue-tail q) nil))
|
||||
;; multi item left, move forward the head
|
||||
(setf (aj-queue-head q) (cdr ret)))
|
||||
(setf (ace-jump-queue-head q) (cdr ret)))
|
||||
(car ret)))
|
||||
|
||||
|
||||
@ -240,8 +240,8 @@ Currently, the valid submode is:
|
||||
")
|
||||
|
||||
(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))
|
||||
(nconc (cl-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.
|
||||
Each key should only an printable character, whose name will
|
||||
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'.
|
||||
|
||||
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)))))))))))
|
||||
The returned value is a list of `ace-jump-position' record."
|
||||
(cl-loop for va in visual-area-list
|
||||
append (let* ((current-window (ace-jump-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))
|
||||
(cl-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-ace-jump-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.
|
||||
@ -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,
|
||||
while a child node list when type is 'branch"
|
||||
(let ((left-leaf-node (- total-leaf-node 1))
|
||||
(q (make-aj-queue))
|
||||
(q (make-ace-jump-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)
|
||||
(ace-jump-queue-push root q)
|
||||
(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
|
||||
;; branch node, we lose a leaft node
|
||||
(setf (car node) 'branch)
|
||||
@ -404,8 +404,8 @@ while a child node list when type is 'branch"
|
||||
;; current child can fill the left leaf
|
||||
(progn
|
||||
(setf (cdr node)
|
||||
(loop for i from 1 to left-leaf-node
|
||||
collect (cons 'leaf nil)))
|
||||
(cl-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
|
||||
@ -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
|
||||
;; 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)))
|
||||
(cl-loop for i from 1 to max-child-node
|
||||
collect (let ((n (cons 'leaf nil)))
|
||||
(ace-jump-queue-push n q)
|
||||
n)))
|
||||
(setq left-leaf-node (- left-leaf-node max-child-node)))))
|
||||
;; return the root node
|
||||
root))
|
||||
@ -448,34 +448,34 @@ node and call LEAF-FUNC on each leaf node"
|
||||
(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)
|
||||
(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))))))
|
||||
;; 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 (ace-jump-position-offset p))
|
||||
(w (ace-jump-position-window p))
|
||||
(b (ace-jump-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 ace-jump-position data with overlay
|
||||
;; so that we can use it to do the final jump
|
||||
(overlay-put ol 'ace-jump-data p)
|
||||
;; next candidate node
|
||||
(setq position-list (cdr position-list))))))
|
||||
(ace-jump-tree-preorder-traverse tree func-create-overlay)
|
||||
tree))
|
||||
|
||||
@ -488,51 +488,51 @@ node and call LEAF-FUNC on each leaf node"
|
||||
(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)))
|
||||
"Get the char under the POS, which is ace-jump-position structure."
|
||||
(let* ((w (ace-jump-position-window pos))
|
||||
(offset (ace-jump-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))))))
|
||||
(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 'ace-jump-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))) ? ))))))))))
|
||||
(cl-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))))))
|
||||
|
||||
|
||||
|
||||
@ -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."
|
||||
(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))))
|
||||
(cl-loop for f in (frame-list)
|
||||
append (cl-loop for w in (window-list f)
|
||||
collect (make-ace-jump-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))))
|
||||
(cl-loop for f in (frame-list)
|
||||
if (eq t (frame-visible-p f))
|
||||
append (cl-loop for w in (window-list f)
|
||||
collect (make-ace-jump-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))))
|
||||
(cl-loop for w in (window-list (selected-frame))
|
||||
collect (make-ace-jump-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))))
|
||||
(make-ace-jump-visual-area :buffer (current-buffer)
|
||||
:window (selected-window)
|
||||
:frame (selected-frame))))
|
||||
(t
|
||||
(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
|
||||
(if (or (null ace-jump-mode-move-keys)
|
||||
(< (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"))
|
||||
;; search candidate position
|
||||
(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
|
||||
(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))))
|
||||
(cl-loop for va in visual-area-list
|
||||
collect (let* ((w (ace-jump-visual-area-window va))
|
||||
(b (ace-jump-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
|
||||
@ -643,11 +643,11 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
|
||||
|
||||
|
||||
(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))
|
||||
"Jump to the POSITION, which is a `ace-jump-position' structure storing the position information"
|
||||
(let ((offset (ace-jump-position-offset position))
|
||||
(frame (ace-jump-position-frame position))
|
||||
(window (ace-jump-position-window position))
|
||||
(buffer (ace-jump-position-buffer position))
|
||||
(line-mode-column 0))
|
||||
|
||||
;; 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
|
||||
(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 ()
|
||||
"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)
|
||||
;; 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)))))
|
||||
(let ((pos (make-ace-jump-position :offset (point)
|
||||
:visual-area (make-ace-jump-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)
|
||||
@ -702,7 +701,7 @@ You can constrol whether use the case sensitive via `ace-jump-mode-case-fold'.
|
||||
(interactive)
|
||||
;; we jump over the killed buffer position
|
||||
(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)))))
|
||||
(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)))
|
||||
;; 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 (eq (current-buffer) (ace-jump-position-buffer p))
|
||||
(if (equal (ace-jump-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
|
||||
@ -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
|
||||
(lexical-let ((po (aj-position-offset p)))
|
||||
(let ((po (ace-jump-position-offset p)))
|
||||
(setq mark-ring
|
||||
(ace-jump-move-first-to-end-if mark-ring
|
||||
(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
|
||||
;; 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)))
|
||||
(let ((pb (ace-jump-position-buffer p)))
|
||||
(setq global-mark-ring
|
||||
(ace-jump-move-first-to-end-if global-mark-ring
|
||||
(lambda (x)
|
||||
@ -802,7 +801,7 @@ word-mode and char-mode"
|
||||
(if ace-jump-current-mode (ace-jump-done))
|
||||
|
||||
(if (eq (ace-jump-char-category query-char) 'other)
|
||||
(error "[AceJump] Non-printable character"))
|
||||
(error "[AceJump] Non-printable character"))
|
||||
|
||||
;; others : digit , alpha, punc
|
||||
(setq ace-jump-query-char query-char)
|
||||
@ -895,8 +894,8 @@ You can constrol whether use the case sensitive via
|
||||
(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)))
|
||||
(let* ((index (let ((ret (cl-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
|
||||
@ -923,11 +922,11 @@ You can constrol whether use the case sensitive via
|
||||
;; 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)))
|
||||
(let ((ace-jump-data (overlay-get (cdr node) 'ace-jump-data)))
|
||||
(ace-jump-push-mark)
|
||||
(run-hooks 'ace-jump-mode-before-jump-hook)
|
||||
(ace-jump-jump-to aj-data))
|
||||
(ace-jump-done)
|
||||
(ace-jump-jump-to ace-jump-data))
|
||||
(ace-jump-done)
|
||||
(run-hooks 'ace-jump-mode-end-hook))
|
||||
(t
|
||||
(ace-jump-done)
|
||||
@ -947,8 +946,8 @@ You can constrol whether use the case sensitive via
|
||||
(force-mode-line-update)
|
||||
|
||||
;; delete background overlay
|
||||
(loop for ol in ace-jump-background-overlay-list
|
||||
do (delete-overlay ol))
|
||||
(cl-loop for ol in ace-jump-background-overlay-list
|
||||
do (delete-overlay ol))
|
||||
(setq ace-jump-background-overlay-list nil)
|
||||
|
||||
|
||||
@ -981,17 +980,17 @@ 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))))
|
||||
(cl-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)
|
||||
(let ((pred pred)
|
||||
found)
|
||||
(ace-jump-move-to-end-if l
|
||||
(lambda (x)
|
||||
(if found
|
||||
@ -1003,19 +1002,19 @@ Such as : (lambda (x) (equal x 1)) "
|
||||
(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)))
|
||||
(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))))))))
|
||||
(and (equal (ace-jump-position-offset x) mp)
|
||||
(eq (ace-jump-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'."
|
||||
Move the ace-jump-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))
|
||||
@ -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)))
|
||||
(if index
|
||||
;; find the mark
|
||||
(lexical-let ((mb (marker-buffer (car index))))
|
||||
(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))))))))
|
||||
(eq (ace-jump-position-buffer x) mb))))))))
|
||||
|
||||
|
||||
(defun ace-jump-mode-enable-mark-sync ()
|
||||
@ -1071,4 +1070,3 @@ will stop synchronizing mark information with emacs mark ring. "
|
||||
;; Local Variables:
|
||||
;; byte-compile-warnings: (not cl-functions)
|
||||
;; End:
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user