Skip to content

Expand/shrink backward edge of selection #36

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
MikeTheGreat wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Expand/shrink backward edge of selection #36

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b14c2d4
Tentative change: [,] adjust left edge for 'word'
MikeTheGreat Nov 24, 2018
bf44ddb
Removed 'message' lines that were used for printf-style debugging
MikeTheGreat Dec 17, 2018
bba0622
Remove my 'todo' comment from the top of the file
MikeTheGreat Dec 17, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
96 changes: 64 additions & 32 deletions easy-kill.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@

;;; Code:


(require 'cl-lib)
(require 'thingatpt)
(require 'gv nil t) ;For `defsetf'.
Expand Down Expand Up @@ -123,6 +124,8 @@ deprecated."
(let ((map (make-sparse-keymap)))
(define-key map "-" 'easy-kill-shrink)
(define-key map "+" 'easy-kill-expand)
(define-key map "[" 'easy-kill-shrink-backward-edge)
(define-key map "]" 'easy-kill-expand-backward-edge)
(define-key map "=" 'easy-kill-expand)
(define-key map " " 'easy-kill-cycle)
(define-key map "@" 'easy-kill-append)
Expand Down Expand Up @@ -364,10 +367,10 @@ candidate property instead."
(interprogram-paste-function nil))
(kill-new (if (and (easy-kill-get append) kill-ring)
(cl-labels ((join (x sep y)
(if sep (concat (easy-kill-trim x 'right)
sep
(easy-kill-trim y 'left))
(concat x y))))
(if sep (concat (easy-kill-trim x 'right)
sep
(easy-kill-trim y 'left))
(concat x y))))
(join (car kill-ring)
(nth 2 (cl-rassoc (easy-kill-get thing)
easy-kill-alist :key #'car))
Expand All @@ -393,6 +396,10 @@ candidate property instead."
(interactive)
(easy-kill-thing nil '+))

(defun easy-kill-expand-backward-edge ()
(interactive)
(easy-kill-thing nil '+ nil 'backward))

(defun easy-kill-cycle (&optional thing)
"Cycle through things in `easy-kill-alist'.
A thing is opted out of cycling if in `easy-kill-cycle-ignored'."
Expand Down Expand Up @@ -433,6 +440,10 @@ expansion."
(interactive)
(easy-kill-thing nil '-))

(defun easy-kill-shrink-backward-edge ()
(interactive)
(easy-kill-thing nil '- nil 'backward))

(defun easy-kill-thing-handler (base mode)
"Get the handler for MODE or nil if none is defined.
For example, if BASE is \"easy-kill-on-list\" and MODE is
Expand All @@ -455,10 +466,10 @@ checked."
;; `thing-at-point-bounds-of-url-at-point' that could return a
;; boundary not containing current point.
(cl-flet ((chk (bound)
(pcase-let ((`(,b . ,e) bound))
(and b e
(<= b (point)) (<= (point) e)
(cons b e)))))
(pcase-let ((`(,b . ,e) bound))
(and b e
(<= b (point)) (<= (point) e)
(cons b e)))))
(pcase (easy-kill-thing-handler
(format "easy-kill-bounds-of-%s-at-point" thing)
major-mode)
Expand All @@ -474,32 +485,51 @@ checked."
(_ (forward-thing thing n))))

;; Helper for `easy-kill-thing'.
(defun easy-kill-thing-forward (n)

;; which-edge:
;; nil or 'forward is the forward edge
;; (the right-most one on RTL text)
;; 'backward is the backward edge
;; (the left-most one on RTL text)
;; forward/backward is defined according to https://www.gnu.org/software/emacs/manual/html_node/emacs/Bidirectional-Editing.html
;;
(defun easy-kill-thing-forward (n &optional which-edge)
(when (and (easy-kill-get thing) (/= n 0))
(let* ((step (if (cl-minusp n) -1 +1))
(thing (easy-kill-get thing))
(bounds1 (or (easy-kill-pair-to-list
(easy-kill-bounds-of-thing-at-point thing))
(list (point) (point))))
(origin-thing-start (car bounds1))
(origin-thing-end (car (last bounds1)))
(start (easy-kill-get start))
(end (easy-kill-get end))
(front (or (car (cl-set-difference (list end start) bounds1))
(pcase step
(`-1 start)
(`1 end))))
(new-front (save-excursion
(goto-char front)
(with-demoted-errors
(dotimes (_ (abs n))
(easy-kill-thing-forward-1 thing step)))
(point))))
(front (cond
( (eq which-edge 'backward)
start)
( t
end)))
(new-front (save-excursion
(goto-char front)
(with-demoted-errors
(dotimes (_ (abs n))
(easy-kill-thing-forward-1 thing step)))
(point))))
(pcase (and (/= front new-front)
(sort (cons new-front bounds1) #'<))
(`(,start ,_ ,end)
(easy-kill-adjust-candidate thing start end)
t)))))

(defun easy-kill-thing (&optional thing n inhibit-handler)
(cond
( (eq which-edge 'backward)
(if (cl-minusp n)
(list new-front end))
(list (min new-front origin-thing-start) end ))
( (eq which-edge nil)
(if (cl-minusp n)
(list start (max new-front origin-thing-end ))
(list start new-front)))))
(`(,start ,end)
(easy-kill-adjust-candidate thing start end)
t) ) ) ) )

(defun easy-kill-thing (&optional thing n inhibit-handler which-edge)
;; N can be -, + and digits
(interactive
(list (pcase (assq last-command-event easy-kill-alist)
Expand All @@ -521,13 +551,15 @@ checked."
(easy-kill-thing-forward (pcase n
(`+ 1)
(`- -1)
(_ n))))
(_ n))
which-edge
))
(t (pcase (easy-kill-bounds-of-thing-at-point thing)
(`nil (easy-kill-echo "No `%s'" thing))
(`(,start . ,end)
(easy-kill-adjust-candidate thing start end)
(unless (zerop n)
(easy-kill-thing-forward (1- n)))))))
(easy-kill-thing-forward (1- n) which-edge))))))
(when (easy-kill-get mark)
(easy-kill-adjust-candidate (easy-kill-get thing)))))

Expand Down Expand Up @@ -690,11 +722,11 @@ inspected."
(if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url))
(easy-kill-thing 'url nil t)
(cl-labels ((get-url (text)
(when (stringp text)
(with-temp-buffer
(insert text)
(pcase (easy-kill-bounds-of-thing-at-point 'url)
(`(,beg . ,end) (buffer-substring beg end)))))))
(when (stringp text)
(with-temp-buffer
(insert text)
(pcase (easy-kill-bounds-of-thing-at-point 'url)
(`(,beg . ,end) (buffer-substring beg end)))))))
(cl-dolist (p '(help-echo shr-url w3m-href-anchor))
(pcase (get-char-property-and-overlay (point) p)
(`(,text . ,ov)
Expand Down