1 ;;; easy-kill.el --- kill & mark things easily -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
5 ;; Author: Leo Liu <sdl.web@gmail.com>
7 ;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
8 ;; Keywords: killing, convenience
10 ;; URL: https://github.com/leoliu/easy-kill
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;; `easy-kill' aims to be a drop-in replacement for `kill-ring-save'.
29 ;; To use: (global-set-key [remap kill-ring-save] 'easy-kill)
31 ;; `easy-mark' is similar to `easy-kill' but marks the region
32 ;; immediately. It can be a handy replacement for `mark-sexp' allowing
33 ;; `+'/`-' to do list-wise expanding/shrinking.
35 ;; To use: (global-set-key [remap mark-sexp] 'easy-mark)
37 ;; Please send bug reports or feature requests to:
38 ;; https://github.com/leoliu/easy-kill/issues
44 (eval-when-compile (require 'cl)) ;For `defsetf'.
48 ((fboundp 'set-transient-map) nil)
49 ((fboundp 'set-temporary-overlay-map) ; new in 24.3
50 (defalias 'set-transient-map 'set-temporary-overlay-map))
52 (defun set-transient-map (map &optional keep-pred)
53 (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
54 (overlaysym (make-symbol "t"))
55 (alist (list (cons overlaysym map)))
58 (unless ,(cond ((null keep-pred) nil)
62 (this-command-keys-vector))))
63 (t `(funcall ',keep-pred)))
64 (set ',overlaysym nil) ;Just in case.
65 (remove-hook 'pre-command-hook ',clearfunsym)
66 (setq emulation-mode-map-alists
67 (delq ',alist emulation-mode-map-alists))))))
68 (set overlaysym overlaysym)
69 (fset clearfunsym clearfun)
70 (add-hook 'pre-command-hook clearfunsym)
71 (push alist emulation-mode-map-alists))))))
73 (defcustom easy-kill-alist '((?w word " ")
79 (?b buffer-file-name))
80 "A list of (CHAR THING APPEND).
81 CHAR is used immediately following `easy-kill' to select THING.
82 APPEND is optional and if non-nil specifies the separator (a
83 string) for appending current selection to previous kill.
85 Note: each element can also be (CHAR . THING) but this is
87 :type '(repeat (list character symbol
88 (choice string (const :tag "None" nil))))
91 (defcustom easy-kill-try-things '(url email line)
92 "A list of things for `easy-kill' to try."
93 :type '(repeat symbol)
96 (defcustom easy-mark-try-things '(url email sexp)
97 "A list of things for `easy-mark' to try."
98 :type '(repeat symbol)
101 (defface easy-kill-selection '((t (:inherit secondary-selection)))
102 "Faced used to highlight kill candidate."
105 (defface easy-kill-origin '((t (:inverse-video t :inherit error)))
106 "Faced used to highlight the origin."
109 (defvar easy-kill-base-map
110 (let ((map (make-sparse-keymap)))
111 (define-key map "-" 'easy-kill-shrink)
112 (define-key map "+" 'easy-kill-expand)
113 (define-key map "=" 'easy-kill-expand)
114 (define-key map "@" 'easy-kill-append)
115 ;; Note: didn't pick C-h because it is a very useful prefix key.
116 (define-key map "?" 'easy-kill-help)
117 (define-key map [remap set-mark-command] 'easy-kill-mark-region)
118 (define-key map [remap kill-region] 'easy-kill-region)
119 (define-key map [remap keyboard-quit] 'easy-kill-abort)
120 (define-key map [remap exchange-point-and-mark]
121 'easy-kill-exchange-point-and-mark)
123 (define-key map (number-to-string d) 'easy-kill-digit-argument))
124 (number-sequence 0 9))
127 (defvar easy-kill-inhibit-message nil)
129 (defun easy-kill-echo (format-string &rest args)
130 "Same as `message' except not writing to *Messages* buffer.
131 Do nothing if `easy-kill-inhibit-message' is non-nil."
132 (unless easy-kill-inhibit-message
133 (let (message-log-max)
134 (apply 'message format-string args))))
136 (defun easy-kill-trim (s &optional how)
137 (let ((wchars "[ \t\n\r\f\v]*"))
139 (`left (and (string-match (concat "\\`" wchars) s)
140 (substring s (match-end 0))))
141 (`right (substring s 0 (string-match-p (concat wchars "\\'") s)))
142 (_ (easy-kill-trim (easy-kill-trim s 'left) 'right)))))
144 (defun easy-kill-mode-sname (m)
145 (cl-check-type m (and (or symbol string) (not boolean)))
147 (symbol (easy-kill-mode-sname (symbol-name m)))
148 (string (substring m 0 (string-match-p "\\(?:-minor\\)?-mode\\'" m)))))
150 (defun easy-kill-fboundp (name)
151 "Like `fboundp' but NAME can be string or symbol.
152 The value is the function's symbol if non-nil."
154 (string (easy-kill-fboundp (intern-soft name)))
155 (symbol (and (fboundp name) name))))
157 (defun easy-kill-pair-to-list (pair)
160 (`(,beg . ,end) (list beg end))
161 (_ (signal 'wrong-type-argument (list pair "Not a dot pair")))))
163 (defun easy-kill-interprogram-cut (text)
164 "Make non-empty TEXT available to other programs."
165 (cl-check-type text string)
166 (and interprogram-cut-function
167 (not (equal text ""))
168 (funcall interprogram-cut-function text)))
170 (defun easy-kill-map ()
171 "Build the keymap according to `easy-kill-alist'."
172 (let ((map (make-sparse-keymap)))
173 (set-keymap-parent map easy-kill-base-map)
175 ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select)
176 (define-key map (char-to-string c) 'easy-kill-thing))
177 (mapcar 'car easy-kill-alist))
180 (defun easy-kill--fmt (x y &optional z)
182 (character (easy-kill--fmt
183 (single-key-description x)
185 (and z (let ((print-escape-newlines t))
186 (prin1-to-string z)))))
187 (string (with-output-to-string
189 (princ (make-string (- 16 (mod (length x) 16)) ?\s))
192 (princ (make-string (- 16 (mod (length y) 16)) ?\s))
195 (defun easy-kill-help ()
197 (help-setup-xref '(easy-kill-help) (called-interactively-p 'any))
198 (with-help-window (help-buffer)
199 (princ (concat (make-string 15 ?=) " "))
200 (princ "Easy Kill/Mark Key Bindings ")
201 (princ (concat (make-string 15 ?=) "\n\n"))
202 (princ (easy-kill--fmt "Key" "Thing" "Separator"))
204 (princ (easy-kill--fmt "---" "-----" "---------"))
206 (princ (mapconcat (lambda (x) (pcase x
208 (easy-kill--fmt c thing sep))
209 ((or `(,c ,thing) `(,c . ,thing))
210 (easy-kill--fmt c thing))))
211 easy-kill-alist "\n"))
213 (princ (substitute-command-keys "\\{easy-kill-base-map}"))))
215 (defvar easy-kill-candidate nil)
217 (defun easy-kill--bounds ()
218 (cons (overlay-start easy-kill-candidate)
219 (overlay-end easy-kill-candidate)))
221 ;;; Note: gv-define-setter not available in 24.1 and 24.2
222 ;; (gv-define-setter easy-kill--bounds (val)
223 ;; (macroexp-let2 macroexp-copyable-p v val
224 ;; `(move-overlay easy-kill-candidate (car ,v) (cdr ,v))))
226 (defsetf easy-kill--bounds () (v)
228 (move-overlay easy-kill-candidate (car tmp) (cdr tmp))))
230 (defmacro easy-kill-get (prop)
231 "Get the value of the kill candidate's property PROP.
232 Use `setf' to change property value."
234 (`start '(overlay-start easy-kill-candidate))
235 (`end '(overlay-end easy-kill-candidate))
236 (`bounds '(easy-kill--bounds))
237 (`buffer '(overlay-buffer easy-kill-candidate))
238 (`properties '(append (list 'start (easy-kill-get start))
239 (list 'end (easy-kill-get end))
240 (list 'buffer (easy-kill-get buffer))
241 (overlay-properties easy-kill-candidate)))
242 (_ `(overlay-get easy-kill-candidate ',prop))))
244 (defun easy-kill-init-candidate (n &optional mark)
245 ;; Manipulate `easy-kill-candidate' directly during initialisation;
246 ;; should use `easy-kill-get' elsewhere.
247 (let ((o (make-overlay (point) (point))))
249 (overlay-put o 'face 'easy-kill-selection))
250 (overlay-put o 'origin (point))
251 (overlay-put o 'help-echo #'easy-kill-describe-candidate)
252 ;; Use higher priority to avoid shadowing by, for example,
254 (overlay-put o 'priority 999)
256 (overlay-put o 'mark 'start)
257 (let ((i (make-overlay (point) (point))))
258 (overlay-put i 'priority (1+ (overlay-get o 'priority)))
259 (overlay-put i 'face 'easy-kill-origin)
260 (overlay-put i 'as (propertize " " 'face 'easy-kill-origin))
261 (overlay-put o 'origin-indicator i)))
262 (setq easy-kill-candidate o)
264 ;; Work around http://debbugs.gnu.org/15808; not needed in 24.4.
265 (narrow-to-region (max (point-min) (- (point) 1000))
266 (min (point-max) (+ (point) 1000)))
267 (let ((easy-kill-inhibit-message t))
268 (cl-dolist (thing easy-kill-try-things)
269 (easy-kill-thing thing n)
270 (or (string= (easy-kill-candidate) "")
274 (defun easy-kill-indicate-origin ()
275 (let ((i (easy-kill-get origin-indicator))
276 (origin (easy-kill-get origin)))
278 ((not (overlayp i)) nil)
280 (overlay-put i 'after-string nil))
281 ((memq (char-after origin) '(?\t ?\n))
282 (overlay-put i 'after-string (overlay-get i 'as)))
283 (t (move-overlay i origin (1+ origin))
284 (overlay-put i 'after-string nil)))))
286 (defun easy-kill-candidate ()
287 "Get the kill candidate as a string.
288 If the overlay specified by variable `easy-kill-candidate' has
289 non-zero length, it is the string covered by the overlay.
290 Otherwise, it is the value of the overlay's candidate property."
291 (with-current-buffer (easy-kill-get buffer)
292 (or (pcase (easy-kill-get bounds)
293 (`(,_x . ,_x) (easy-kill-get candidate))
294 (`(,beg . ,end) (filter-buffer-substring beg end)))
297 (defun easy-kill-describe-candidate (&rest _)
298 "Return a string that describes current kill candidate."
299 (let* ((props (cl-loop for k in '(thing start end origin)
300 with all = (easy-kill-get properties)
301 ;; Allow describe-PROP to provide customised
303 for dk = (intern-soft (format "describe-%s" k))
304 for dv = (and dk (plist-get all dk))
305 for v = (or (if (functionp dv) (funcall dv) dv)
307 when v collect (format "%s:\t%s" k v)))
308 (txt (mapconcat #'identity props "\n")))
309 (format "cmd:\t%s\n%s"
310 (if (easy-kill-get mark) "easy-mark" "easy-kill")
313 (defun easy-kill-adjust-candidate (thing &optional beg end)
314 "Adjust kill candidate to THING, BEG, END.
315 If BEG is a string, shrink the overlay to zero length and set its
316 candidate property instead."
317 (setf (easy-kill-get thing) thing)
319 (setf (easy-kill-get bounds) (cons (point) (point)))
320 (setf (easy-kill-get candidate) beg)
321 (let ((easy-kill-inhibit-message nil))
322 (easy-kill-echo "%s" beg)))
324 (setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start))
325 (or end (easy-kill-get end))))))
326 (cond ((easy-kill-get mark)
327 (easy-kill-mark-region)
328 (easy-kill-indicate-origin))
330 (easy-kill-interprogram-cut (easy-kill-candidate)))))
332 (defun easy-kill-save-candidate ()
333 (unless (string= (easy-kill-candidate) "")
334 ;; Don't modify the clipboard here since it is called in
335 ;; `pre-command-hook' per `easy-kill-activate-keymap' and will
336 ;; confuse `yank' if it is current command. Also
337 ;; `easy-kill-adjust-candidate' already did that.
338 (let ((interprogram-cut-function nil)
339 (interprogram-paste-function nil))
340 (kill-new (if (and (easy-kill-get append) kill-ring)
341 (cl-labels ((join (x sep y)
342 (if sep (concat (easy-kill-trim x 'right)
344 (easy-kill-trim y 'left))
346 (join (car kill-ring)
347 (nth 2 (cl-rassoc (easy-kill-get thing)
348 easy-kill-alist :key #'car))
349 (easy-kill-candidate)))
350 (easy-kill-candidate))
351 (easy-kill-get append)))
354 (defun easy-kill-destroy-candidate ()
355 (let ((hook (make-symbol "easy-kill-destroy-candidate")))
356 (fset hook `(lambda ()
357 (let ((o ,easy-kill-candidate))
359 (let ((i (overlay-get o 'origin-indicator)))
360 (and (overlayp i) (delete-overlay i)))
362 (remove-hook 'post-command-hook ',hook)))
363 ;; Run in `post-command-hook' so that exit commands can still use
364 ;; `easy-kill-candidate'.
365 (add-hook 'post-command-hook hook)))
367 (defun easy-kill-expand ()
369 (easy-kill-thing nil '+))
371 (defun easy-kill-digit-argument (n)
372 "Expand selection by N number of things.
373 If N is 0 shrink the selection to the initial size before any
376 (list (- (logand (if (integerp last-command-event)
378 (get last-command-event 'ascii-character))
381 (easy-kill-thing nil n))
383 (defun easy-kill-shrink ()
385 (easy-kill-thing nil '-))
387 (defun easy-kill-thing-handler (base mode)
388 "Get the handler for MODE or nil if none is defined.
389 For example, if BASE is \"easy-kill-on-list\" and MODE is
390 nxml-mode `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are
391 checked in order. The former is never defined in this package and
392 is safe for users to customise. If neither is defined continue
393 checking on the parent mode. Finally `easy-kill-on-list' is
395 (or (and mode (or (easy-kill-fboundp
396 (concat (easy-kill-mode-sname mode) ":" base))
398 (concat base ":" (easy-kill-mode-sname mode)))))
399 (let ((parent (get mode 'derived-mode-parent)))
400 (and parent (easy-kill-thing-handler base parent)))
401 (easy-kill-fboundp base)))
403 (defun easy-kill-bounds-of-thing-at-point (thing)
404 "Easy Kill wrapper for `bounds-of-thing-at-point'."
405 (pcase (easy-kill-thing-handler
406 (format "easy-kill-bounds-of-%s-at-point" thing)
408 ((and (pred functionp) fn) (funcall fn))
409 (_ (bounds-of-thing-at-point thing))))
411 (defun easy-kill-thing-forward-1 (thing &optional n)
412 "Easy Kill wrapper for `forward-thing'."
413 (pcase (easy-kill-thing-handler
414 (format "easy-kill-thing-forward-%s" thing)
416 ((and (pred functionp) fn) (funcall fn n))
417 (_ (forward-thing thing n))))
419 ;; Helper for `easy-kill-thing'.
420 (defun easy-kill-thing-forward (n)
421 (when (and (easy-kill-get thing) (/= n 0))
422 (let* ((step (if (cl-minusp n) -1 +1))
423 (thing (easy-kill-get thing))
424 (bounds1 (or (easy-kill-pair-to-list
425 (easy-kill-bounds-of-thing-at-point thing))
426 (list (point) (point))))
427 (start (easy-kill-get start))
428 (end (easy-kill-get end))
429 (front (or (car (cl-set-difference (list end start) bounds1))
433 (new-front (save-excursion
437 (easy-kill-thing-forward-1 thing step)))
439 (pcase (and (/= front new-front)
440 (sort (cons new-front bounds1) #'<))
442 (easy-kill-adjust-candidate thing start end)
445 (defun easy-kill-thing (&optional thing n inhibit-handler)
446 ;; N can be -, + and digits
448 (list (pcase (assq last-command-event easy-kill-alist)
451 (prefix-numeric-value current-prefix-arg)))
452 (let* ((thing (or thing (easy-kill-get thing)))
454 (handler (and (not inhibit-handler)
455 (easy-kill-thing-handler (format "easy-kill-on-%s" thing)
457 (when (easy-kill-get mark)
458 (goto-char (easy-kill-get origin)))
460 (handler (funcall handler n))
462 (and (eq thing (easy-kill-get thing))
464 (easy-kill-thing-forward (pcase n
468 (t (pcase (easy-kill-bounds-of-thing-at-point thing)
469 (`nil (easy-kill-echo "No `%s'" thing))
471 (easy-kill-adjust-candidate thing start end)
473 (easy-kill-thing-forward (1- n)))))))
474 (when (easy-kill-get mark)
475 (easy-kill-adjust-candidate (easy-kill-get thing)))))
477 (put 'easy-kill-abort 'easy-kill-exit t)
478 (defun easy-kill-abort ()
480 (when (easy-kill-get mark)
481 ;; The after-string may interfere with `goto-char'.
482 (overlay-put (easy-kill-get origin-indicator) 'after-string nil)
483 (goto-char (easy-kill-get origin))
484 (setq deactivate-mark t))
487 (put 'easy-kill-region 'easy-kill-exit t)
488 (defun easy-kill-region ()
489 "Kill current selection and exit."
491 (pcase (easy-kill-get bounds)
492 (`(,_x . ,_x) (easy-kill-echo "Empty region"))
493 (`(,beg . ,end) (kill-region beg end))))
495 (put 'easy-kill-mark-region 'easy-kill-exit t)
496 (defun easy-kill-mark-region ()
498 (pcase (easy-kill-get bounds)
500 (easy-kill-echo "Empty region"))
502 (pcase (if (eq (easy-kill-get mark) 'end)
503 (list end beg) (list beg end))
509 (defun easy-kill-exchange-point-and-mark ()
511 (exchange-point-and-mark)
512 (setf (easy-kill-get mark)
513 (if (eq (point) (easy-kill-get start))
516 (put 'easy-kill-append 'easy-kill-exit t)
517 (defun easy-kill-append ()
519 (setf (easy-kill-get append) t)
520 (when (easy-kill-save-candidate)
521 (easy-kill-interprogram-cut (car kill-ring))
522 (setq deactivate-mark t)
523 (easy-kill-echo "Appended")))
525 (defun easy-kill-exit-p (cmd)
526 (and (symbolp cmd) (get cmd 'easy-kill-exit)))
528 (defun easy-kill-activate-keymap ()
529 (let ((map (easy-kill-map)))
533 ;; Prevent any error from activating the keymap forever.
535 (or (and (not (easy-kill-exit-p this-command))
537 (lookup-key map (this-single-command-keys)))
538 (let ((cmd (key-binding
539 (this-single-command-keys) nil t)))
540 (command-remapping cmd nil (list map)))))
542 (easy-kill-destroy-candidate)
543 (unless (or (easy-kill-get mark) (easy-kill-exit-p this-command))
544 (easy-kill-save-candidate))))
545 (error (message "%s:%s" this-command (error-message-string err))
549 (defun easy-kill (&optional n)
550 "Kill thing at point in the order of region, url, email and line.
551 Temporally activate additional key bindings as follows:
553 letters => select or expand selection according to `easy-kill-alist';
554 1..9 => expand selection by that number;
555 0 => shrink to the initial selection;
556 +,=/- => expand or shrink selection;
557 @ => append selection to previous kill;
559 C-w => kill selection;
560 C-SPC => turn selection into an active region;
562 others => save selection and exit."
565 (if (fboundp 'rectangle-mark-mode) ; New in 24.4
567 (kill-ring-save (region-beginning) (region-end) t))
568 (kill-ring-save (region-beginning) (region-end)))
569 (easy-kill-init-candidate n)
570 (setf (easy-kill-get append) (eq last-command 'kill-region))
571 (when (zerop (buffer-size))
572 (easy-kill-echo "Warn: `easy-kill' activated in empty buffer"))
573 (easy-kill-activate-keymap)))
576 (defalias 'easy-mark-sexp 'easy-mark
577 "Use `easy-mark' instead. The alias may be removed in future.")
580 (defun easy-mark (&optional n)
581 "Similar to `easy-kill' (which see) but for marking."
583 (let ((easy-kill-try-things easy-mark-try-things))
584 (easy-kill-init-candidate n 'mark)
585 (easy-kill-activate-keymap)
586 (unless (easy-kill-get thing)
587 (setf (easy-kill-get thing) 'sexp)
588 (easy-kill-thing 'sexp n))))
592 ;;; Handler for `buffer-file-name'.
594 (defun easy-kill-on-buffer-file-name (n)
595 "Get `buffer-file-name' or `default-directory'.
596 If N is zero, remove the directory part; -, remove the file name
598 (if (easy-kill-get mark)
599 (easy-kill-echo "Not supported in `easy-mark'")
600 (pcase (or buffer-file-name default-directory)
601 (`nil (easy-kill-echo "No `buffer-file-name'"))
602 (file (let* ((file (directory-file-name file))
604 (`- (file-name-directory file))
605 (`0 (file-name-nondirectory file))
607 (easy-kill-adjust-candidate 'buffer-file-name text))))))
609 ;;; Handler for `defun-name'.
611 (defun easy-kill-on-defun-name (_n)
612 "Get current defun name."
613 (if (easy-kill-get mark)
614 (easy-kill-echo "Not supported in `easy-mark'")
615 (pcase (add-log-current-defun)
616 (`nil (easy-kill-echo "No `defun-name' at point"))
617 (name (easy-kill-adjust-candidate 'defun-name name)))))
619 ;;; Handler for `url'.
621 (defun easy-kill-on-url (&optional _n)
622 "Get url at point or from char properties.
623 Char properties `help-echo', `shr-url' and `w3m-href-anchor' are
625 (if (or (easy-kill-get mark) (easy-kill-bounds-of-thing-at-point 'url))
626 (easy-kill-thing 'url nil t)
627 (cl-labels ((get-url (text)
631 (pcase (easy-kill-bounds-of-thing-at-point 'url)
632 (`(,beg . ,end) (buffer-substring beg end)))))))
633 (cl-dolist (p '(help-echo shr-url w3m-href-anchor))
634 (pcase (get-char-property-and-overlay (point) p)
636 (pcase (or (get-url text)
637 (get-url (and ov (overlay-get ov p))))
638 ((and url (guard url))
639 (easy-kill-adjust-candidate 'url url)
640 (cl-return url)))))))))
644 ;; Work around http://debbugs.gnu.org/17247
645 (defun easy-kill-thing-forward-defun (&optional n)
647 ((pred cl-minusp) (beginning-of-defun (- n)))
648 (n (end-of-defun n))))
650 ;;; Handler for `sexp' and `list'.
652 (defun easy-kill-bounds-of-list-at-point ()
653 (let ((bos (and (nth 3 (syntax-ppss)) ;bounds of string
655 (easy-kill-backward-up)
656 (easy-kill-bounds-of-thing-at-point 'sexp))))
657 (b (bounds-of-thing-at-point 'list))
658 (b1-in-b2 (lambda (b1 b2)
659 (and (> (car b1) (car b2))
660 (< (cdr b1) (cdr b2))))))
664 ((= (car b) (point)) bos)
665 ((funcall b1-in-b2 b bos) b)
668 (defvar up-list-fn) ; Dynamically bound
670 (defun easy-kill-backward-up ()
671 (let ((ppss (syntax-ppss)))
674 (funcall (or (bound-and-true-p up-list-fn) #'up-list) -1)
675 ;; `up-list' may jump to another string.
676 (when (and (nth 3 ppss) (< (point) (nth 8 ppss)))
677 (goto-char (nth 8 ppss))))
678 (scan-error (and (nth 3 ppss) (goto-char (nth 8 ppss)))))))
680 (defun easy-kill-forward-down (point &optional bound)
683 (easy-kill-backward-up)
684 (backward-prefix-chars)
685 (if (and (or (not bound) (> (point) bound))
687 (easy-kill-forward-down (point) bound)
689 (scan-error (goto-char point))))
691 (defun easy-kill-bounds-of-list (n)
694 (`+ (goto-char (easy-kill-get start))
695 (easy-kill-backward-up))
696 (`- (easy-kill-forward-down (point) (easy-kill-get start)))
697 (_ (error "Unsupported argument `%s'" n)))
698 (easy-kill-bounds-of-thing-at-point 'sexp)))
700 (defun easy-kill-on-list (n)
703 (pcase (easy-kill-bounds-of-list n)
705 (easy-kill-adjust-candidate 'list beg end))))
706 (_ (easy-kill-thing 'list n t))))
708 (defun easy-kill-on-sexp (n)
711 (unwind-protect (easy-kill-thing 'list n)
712 (setf (easy-kill-get thing) 'sexp)))
713 (_ (easy-kill-thing 'sexp n t))))
715 ;;; nxml support for list-wise +/-
717 (defvar nxml-sexp-element-flag)
719 (defun easy-kill-on-list:nxml (n)
720 (let ((nxml-sexp-element-flag t)
721 (up-list-fn 'nxml-up-element))
724 (pcase (easy-kill-bounds-of-list n)
725 (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
726 ((and (eq 'list (easy-kill-get thing))
728 (let ((new-end (save-excursion
729 (goto-char (easy-kill-get end))
732 (when (and new-end (/= new-end (easy-kill-get end)))
733 (easy-kill-adjust-candidate 'list nil new-end))))
735 (ignore-errors (easy-kill-backward-up))
736 (easy-kill-thing 'sexp n t)
737 (setf (easy-kill-get thing) 'list))))))
739 ;;; org support for list-wise +/-
741 (defun easy-kill-bounds-of-list-at-point:org ()
742 (eval-and-compile (require 'org-element))
743 (let ((x (org-element-at-point)))
744 (cons (org-element-property :begin x)
745 (org-element-property :end x))))
747 (defun easy-kill-bounds-of-sexp-at-point:org ()
748 (pcase (list (point) (easy-kill-bounds-of-list-at-point:org))
749 (`(,beg (,beg . ,end))
751 (_ (bounds-of-thing-at-point 'sexp))))
753 (defun easy-kill-thing-forward-list:org (&optional n)
756 (n (dotimes (_ (abs n))
759 (org-backward-element)
760 (org-forward-element))
761 (error (pcase (easy-kill-bounds-of-thing-at-point 'list)
763 (goto-char (if (cl-minusp n) beg end))))))))))
765 (defun easy-kill-org-up-element (&optional n)
766 ;; Make `org-up-element' more like `up-list'.
771 (pcase (list (point) (easy-kill-bounds-of-thing-at-point 'list))
772 (`(,_beg (,_beg . ,_)) (org-up-element))
773 (`(,_ (,beg . ,_)) (goto-char beg)))))
775 (goto-char (cdr (easy-kill-bounds-of-thing-at-point 'list)))))))
777 (defun easy-kill-on-list:org (n)
780 (pcase (let ((up-list-fn #'easy-kill-org-up-element))
781 (easy-kill-bounds-of-list n))
782 (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
783 (_ (easy-kill-thing 'list n t)))
784 (pcase (save-excursion
785 (goto-char (easy-kill-get start))
786 (org-element-type (org-element-at-point)))
788 (type (setf (easy-kill-get describe-thing)
790 (format "%s (%s)" (easy-kill-get thing) type)))
791 (easy-kill-echo "%s" type))))
793 ;;; js2 support for list-wise +/-
795 (defun easy-kill-find-js2-node (beg end &optional inner)
796 (eval-and-compile (require 'js2-mode nil t))
797 (let* ((node (js2-node-at-point))
800 (if (or (js2-ast-root-p node)
801 (and (<= (js2-node-abs-pos node) beg)
802 (>= (js2-node-abs-end node) end)
804 (not (and (= (js2-node-abs-pos node) beg)
805 (= (js2-node-abs-end node) end))))))
808 node (js2-node-parent node))
810 (if inner last-node node)))
812 (defun easy-kill-on-list:js2 (n)
815 (easy-kill-find-js2-node (easy-kill-get start)
818 ((guard (and (eq 'list (easy-kill-get thing))
820 (error "List forward not supported in js2-mode"))
821 (_ (js2-node-at-point)))))
822 (easy-kill-adjust-candidate 'list
823 (js2-node-abs-pos node)
824 (js2-node-abs-end node))
825 (setf (easy-kill-get describe-thing)
826 ;; Also used by `sexp' so delay computation until needed.
828 (format "%s (%s)" (easy-kill-get thing) (js2-node-short-name node))))
829 (easy-kill-echo "%s" (js2-node-short-name node))))
832 ;;; easy-kill.el ends here