code.delx.au - gnu-emacs-elpa/blob - packages/easy-kill/easy-kill.el

   1 ;;; easy-kill.el --- kill & mark things easily       -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013-2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Leo Liu <sdl.web@gmail.com>
   6 ;; Version: 0.9.2
   7 ;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
   8 ;; Keywords: killing, convenience
   9 ;; Created: 2013-08-12
  10 ;; URL: https://github.com/leoliu/easy-kill
  11
  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.
  16
  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.
  21
  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/>.
  24
  25 ;;; Commentary:
  26
  27 ;; `easy-kill' aims to be a drop-in replacement for `kill-ring-save'.
  28 ;;
  29 ;; To use: (global-set-key [remap kill-ring-save] 'easy-kill)
  30
  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.
  34 ;;
  35 ;; To use: (global-set-key [remap mark-sexp] 'easy-mark)
  36
  37 ;; Please send bug reports or feature requests to:
  38 ;;      https://github.com/leoliu/easy-kill/issues
  39
  40 ;;; Code:
  41
  42 (require 'cl-lib)
  43 (require 'thingatpt)
  44 (eval-when-compile (require 'cl))       ;For `defsetf'.
  45
  46 (eval-and-compile
  47   (cond
  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))
  51    (t
  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)))
  56              (clearfun
  57               `(lambda ()
  58                  (unless ,(cond ((null keep-pred) nil)
  59                                 ((eq t keep-pred)
  60                                  `(eq this-command
  61                                       (lookup-key ',map
  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))))))
  72
  73 (defcustom easy-kill-alist
  74   '((?w word     " ")
  75     (?s sexp     "\n")
  76     (?l list     "\n")
  77     (?f filename "\n")
  78     (?d defun    "\n\n")
  79     (?e line     "\n")
  80     (?b buffer-file-name))
  81   "A list of (CHAR THING APPEND).
  82 CHAR is used immediately following `easy-kill' to select THING.
  83 APPEND is optional and if non-nil specifies the separator (a
  84 string) for appending current selection to previous kill.
  85
  86 Note: each element can also be (CHAR . THING) but this is
  87 deprecated."
  88   :type '(repeat (list character symbol
  89                        (choice string (const :tag "None" nil))))
  90   :group 'killing)
  91
  92 (defcustom easy-kill-try-things '(url email line)
  93   "A list of things for `easy-kill' to try."
  94   :type '(repeat symbol)
  95   :group 'killing)
  96
  97 (defcustom easy-mark-try-things '(url email sexp)
  98   "A list of things for `easy-mark' to try."
  99   :type '(repeat symbol)
 100   :group 'killing)
 101
 102 (defface easy-kill-selection '((t (:inherit secondary-selection)))
 103   "Faced used to highlight kill candidate."
 104   :group 'killing)
 105
 106 (defface easy-kill-origin '((t (:inverse-video t :inherit error)))
 107   "Faced used to highlight the origin."
 108   :group 'killing)
 109
 110 (defvar easy-kill-base-map
 111   (let ((map (make-sparse-keymap)))
 112     (define-key map "-" 'easy-kill-shrink)
 113     (define-key map "+" 'easy-kill-expand)
 114     (define-key map "=" 'easy-kill-expand)
 115     (define-key map "@" 'easy-kill-append)
 116     (define-key map [remap set-mark-command] 'easy-kill-mark-region)
 117     (define-key map [remap kill-region] 'easy-kill-region)
 118     (define-key map [remap keyboard-quit] 'easy-kill-abort)
 119     (mapc (lambda (d)
 120             (define-key map (number-to-string d) 'easy-kill-digit-argument))
 121           (number-sequence 0 9))
 122     map))
 123
 124 (defun easy-kill-map ()
 125   "Build the keymap according to `easy-kill-alist'."
 126   (let ((map (make-sparse-keymap)))
 127     (set-keymap-parent map easy-kill-base-map)
 128     (mapc (lambda (c)
 129             ;; (define-key map (vector meta-prefix-char c) 'easy-kill-select)
 130             (define-key map (char-to-string c) 'easy-kill-thing))
 131           (mapcar 'car easy-kill-alist))
 132     map))
 133
 134 (defvar easy-kill-inhibit-message nil)
 135
 136 (defun easy-kill-echo (format-string &rest args)
 137   "Same as `message' except not writing to *Messages* buffer.
 138 Do nothing if `easy-kill-inhibit-message' is non-nil."
 139   (unless easy-kill-inhibit-message
 140     (let (message-log-max)
 141       (apply 'message format-string args))))
 142
 143 (defun easy-kill-trim (s &optional how)
 144   (let ((wchars "[ \t\n\r\f\v]*"))
 145     (pcase how
 146       (`left (and (string-match (concat "\\`" wchars) s)
 147                   (substring s (match-end 0))))
 148       (`right (substring s 0 (string-match-p (concat wchars "\\'") s)))
 149       (_ (easy-kill-trim (easy-kill-trim s 'left) 'right)))))
 150
 151 (defun easy-kill-fboundp (name)
 152   "Like `fboundp' but NAME can be string or symbol.
 153 The value is the function's symbol if non-nil."
 154   (cl-etypecase name
 155     (string (easy-kill-fboundp (intern-soft name)))
 156     (symbol (and (fboundp name) name))))
 157
 158 (defun easy-kill-pair-to-list (pair)
 159   (pcase pair
 160     (`nil nil)
 161     (`(,beg . ,end) (list beg end))
 162     (_ (signal 'wrong-type-argument (list pair "Not a dot pair")))))
 163
 164 (defun easy-kill-interprogram-cut (text)
 165   "Make non-empty TEXT available to other programs."
 166   (cl-check-type text string)
 167   (and interprogram-cut-function
 168        (not (equal text ""))
 169        (funcall interprogram-cut-function text)))
 170
 171 (defvar easy-kill-candidate nil)
 172 (defvar easy-kill-append nil)
 173 (defvar easy-kill-mark nil)
 174
 175 (defun easy-kill--bounds ()
 176   (cons (overlay-start easy-kill-candidate)
 177         (overlay-end easy-kill-candidate)))
 178
 179 ;;; Note: gv-define-setter not available in 24.1 and 24.2
 180 ;; (gv-define-setter easy-kill--bounds (val)
 181 ;;   (macroexp-let2 macroexp-copyable-p v val
 182 ;;     `(move-overlay easy-kill-candidate (car ,v) (cdr ,v))))
 183
 184 (defsetf easy-kill--bounds () (v)
 185   `(let ((tmp ,v))
 186      (move-overlay easy-kill-candidate (car tmp) (cdr tmp))))
 187
 188 (defmacro easy-kill-get (prop)
 189   "Get the value of the kill candidate's property PROP.
 190 Use `setf' to change property value."
 191   (pcase prop
 192     (`start  '(overlay-start easy-kill-candidate))
 193     (`end    '(overlay-end easy-kill-candidate))
 194     (`bounds '(easy-kill--bounds))
 195     (`buffer '(overlay-buffer easy-kill-candidate))
 196     (`properties '(append (list 'start (easy-kill-get start))
 197                           (list 'end (easy-kill-get end))
 198                           (overlay-properties easy-kill-candidate)))
 199     (_       `(overlay-get easy-kill-candidate ',prop))))
 200
 201 (defun easy-kill-init-candidate (n)
 202   ;; Manipulate `easy-kill-candidate' directly during initialisation;
 203   ;; should use `easy-kill-get' elsewhere.
 204   (let ((o (make-overlay (point) (point))))
 205     (unless easy-kill-mark
 206       (overlay-put o 'face 'easy-kill-selection))
 207     (overlay-put o 'origin (point))
 208     (overlay-put o 'help-echo #'easy-kill-describe-candidate)
 209     ;; Use higher priority to avoid shadowing by, for example,
 210     ;; `hl-line-mode'.
 211     (overlay-put o 'priority 999)
 212     (when easy-kill-mark
 213       (let ((i (make-overlay (point) (point))))
 214         (overlay-put i 'priority (1+ (overlay-get o 'priority)))
 215         (overlay-put i 'face 'easy-kill-origin)
 216         (overlay-put i 'as (propertize " " 'face 'easy-kill-origin))
 217         (overlay-put o 'origin-indicator i)))
 218     (setq easy-kill-candidate o)
 219     (save-restriction
 220       ;; Work around http://debbugs.gnu.org/15808; not needed in 24.4.
 221       (narrow-to-region (max (point-min) (- (point) 1000))
 222                         (min (point-max) (+ (point) 1000)))
 223       (let ((easy-kill-inhibit-message t))
 224         (cl-dolist (thing easy-kill-try-things)
 225           (easy-kill-thing thing n)
 226           (or (string= (easy-kill-candidate) "")
 227               (cl-return)))))
 228     o))
 229
 230 (defun easy-kill-indicate-origin ()
 231   (let ((i (easy-kill-get origin-indicator))
 232         (origin (easy-kill-get origin)))
 233     (cond
 234      ((not (overlayp i)) nil)
 235      ((= origin (point))
 236       (overlay-put i 'after-string nil))
 237      ((memq (char-after origin) '(?\t ?\n))
 238       (overlay-put i 'after-string (overlay-get i 'as)))
 239      (t (move-overlay i origin (1+ origin))
 240         (overlay-put i 'after-string nil)))))
 241
 242 (defun easy-kill-candidate ()
 243   "Get the kill candidate as a string.
 244 If the overlay specified by variable `easy-kill-candidate' has
 245 non-zero length, it is the string covered by the overlay.
 246 Otherwise, it is the value of the overlay's candidate property."
 247   (with-current-buffer (easy-kill-get buffer)
 248     (or (pcase (easy-kill-get bounds)
 249           (`(,_x . ,_x) (easy-kill-get candidate))
 250           (`(,beg . ,end) (filter-buffer-substring beg end)))
 251         "")))
 252
 253 (defun easy-kill-describe-candidate (&rest _)
 254   "Return a string that describes current kill candidate."
 255   (let* ((props (cl-loop for k in '(thing start end origin)
 256                          with all = (easy-kill-get properties)
 257                          ;; Allow describe-PROP to provide customised
 258                          ;; description.
 259                          for dk = (intern-soft (format "describe-%s" k))
 260                          for dv = (and dk (plist-get all dk))
 261                          for v = (or (if (functionp dv) (funcall dv) dv)
 262                                      (plist-get all k))
 263                          when v collect (format "%s:\t%s" k v)))
 264          (txt (mapconcat #'identity props "\n")))
 265     (format "cmd:\t%s\n%s" (if easy-kill-mark "easy-mark" "easy-kill") txt)))
 266
 267 (defun easy-kill-adjust-candidate (thing &optional beg end)
 268   "Adjust kill candidate to THING, BEG, END.
 269 If BEG is a string, shrink the overlay to zero length and set its
 270 candidate property instead."
 271   (setf (easy-kill-get thing) thing)
 272   (cond ((stringp beg)
 273          (setf (easy-kill-get bounds) (cons (point) (point)))
 274          (setf (easy-kill-get candidate) beg)
 275          (let ((easy-kill-inhibit-message nil))
 276            (easy-kill-echo "%s" beg)))
 277         (t
 278          (setf (easy-kill-get bounds) (cons (or beg (easy-kill-get start))
 279                                             (or end (easy-kill-get end))))))
 280   (cond (easy-kill-mark (easy-kill-mark-region)
 281                         (easy-kill-indicate-origin))
 282         (t (easy-kill-interprogram-cut (easy-kill-candidate)))))
 283
 284 (defun easy-kill-save-candidate ()
 285   (unless (string= (easy-kill-candidate) "")
 286     ;; Don't modify the clipboard here since it is called in
 287     ;; `pre-command-hook' per `easy-kill-activate-keymap' and will
 288     ;; confuse `yank' if it is current command. Also
 289     ;; `easy-kill-adjust-candidate' already did that.
 290     (let ((interprogram-cut-function nil)
 291           (interprogram-paste-function nil))
 292       (kill-new (if (and easy-kill-append kill-ring)
 293                     (cl-labels ((join (x sep y)
 294                                       (if sep (concat (easy-kill-trim x 'right)
 295                                                       sep
 296                                                       (easy-kill-trim y 'left))
 297                                         (concat x y))))
 298                       (join (car kill-ring)
 299                             (nth 2 (cl-rassoc (easy-kill-get thing)
 300                                               easy-kill-alist :key #'car))
 301                             (easy-kill-candidate)))
 302                   (easy-kill-candidate))
 303                 easy-kill-append))
 304     t))
 305
 306 (defun easy-kill-destroy-candidate ()
 307   (let ((hook (make-symbol "easy-kill-destroy-candidate")))
 308     (fset hook `(lambda ()
 309                   (let ((o ,easy-kill-candidate))
 310                     (when o
 311                       (let ((i (overlay-get o 'origin-indicator)))
 312                         (and (overlayp i) (delete-overlay i)))
 313                       (delete-overlay o)))
 314                   (remove-hook 'post-command-hook ',hook)))
 315     ;; Run in `post-command-hook' so that exit commands can still use
 316     ;; `easy-kill-candidate'.
 317     (add-hook 'post-command-hook hook)))
 318
 319 (defun easy-kill-expand ()
 320   (interactive)
 321   (easy-kill-thing nil '+))
 322
 323 (defun easy-kill-digit-argument (n)
 324   (interactive
 325    (list (- (logand (if (integerp last-command-event)
 326                         last-command-event
 327                       (get last-command-event 'ascii-character))
 328                     ?\177)
 329             ?0)))
 330   (easy-kill-thing nil n))
 331
 332 (defun easy-kill-shrink ()
 333   (interactive)
 334   (easy-kill-thing nil '-))
 335
 336 ;; Helper for `easy-kill-thing'.
 337 (defun easy-kill-thing-forward (n)
 338   (when (and (easy-kill-get thing) (/= n 0))
 339     (let* ((step (if (cl-minusp n) -1 +1))
 340            (thing (easy-kill-get thing))
 341            (bounds1 (or (easy-kill-pair-to-list (bounds-of-thing-at-point thing))
 342                         (list (point) (point))))
 343            (start (easy-kill-get start))
 344            (end (easy-kill-get end))
 345            (front (or (car (cl-set-difference (list end start) bounds1))
 346                       (pcase step
 347                         (`-1 start)
 348                         (`1 end))))
 349            (new-front (save-excursion
 350                         (goto-char front)
 351                         (with-demoted-errors
 352                           (cl-labels ((forward-defun (s)
 353                                                      (pcase s
 354                                                        (`-1 (beginning-of-defun 1))
 355                                                        (`+1 (end-of-defun 1)))))
 356                             (dotimes (_ (abs n))
 357                               ;; Work around http://debbugs.gnu.org/17247
 358                               (if (eq thing 'defun)
 359                                   (forward-defun step)
 360                                 (forward-thing thing step)))))
 361                         (point))))
 362       (pcase (and (/= front new-front)
 363                   (sort (cons new-front bounds1) #'<))
 364         (`(,start ,_ ,end)
 365          (easy-kill-adjust-candidate thing start end)
 366          t)))))
 367
 368 (defun easy-kill-thing-handler (thing mode)
 369   "Get the handler for THING or nil if none is defined.
 370 For example, if THING is list and MODE is nxml-mode
 371 `nxml:easy-kill-on-list', `easy-kill-on-list:nxml' are checked in
 372 order. The former is never defined in this package and is safe
 373 for users to customise. If neither is defined continue checking
 374 on the parent mode. Finally `easy-kill-on-list' is checked."
 375   (cl-labels ((sname (m) (cl-etypecase m
 376                            (symbol (sname (symbol-name m)))
 377                            (string (substring m 0 (string-match-p
 378                                                    "\\(?:-minor\\)?-mode\\'" m))))))
 379     (let ((parent (get mode 'derived-mode-parent)))
 380       (or (and mode (or (easy-kill-fboundp
 381                          (format "%s:easy-kill-on-%s" (sname mode) thing))
 382                         (easy-kill-fboundp
 383                          (format "easy-kill-on-%s:%s" thing (sname mode)))))
 384           (and parent (easy-kill-thing-handler thing parent))
 385           (easy-kill-fboundp (format "easy-kill-on-%s" thing))))))
 386
 387 (defun easy-kill-thing (&optional thing n inhibit-handler)
 388   ;; N can be -, + and digits
 389   (interactive
 390    (list (pcase (assq last-command-event easy-kill-alist)
 391            (`(,_ ,th . ,_) th)
 392            (`(,_ . ,th) th))
 393          (prefix-numeric-value current-prefix-arg)))
 394   (let* ((thing (or thing (easy-kill-get thing)))
 395          (n (or n 1))
 396          (handler (and (not inhibit-handler)
 397                        (easy-kill-thing-handler thing major-mode))))
 398     (when easy-kill-mark
 399       (goto-char (easy-kill-get origin)))
 400     (cond
 401      (handler (funcall handler n))
 402      ((or (eq thing (easy-kill-get thing))
 403           (memq n '(+ -)))
 404       (easy-kill-thing-forward (pcase n
 405                                  (`+ 1)
 406                                  (`- -1)
 407                                  (_ n))))
 408      (t (pcase (bounds-of-thing-at-point thing)
 409           (`nil (easy-kill-echo "No `%s'" thing))
 410           (`(,start . ,end)
 411            (easy-kill-adjust-candidate thing start end)
 412            (easy-kill-thing-forward (1- n))))))
 413     (when easy-kill-mark
 414       (easy-kill-adjust-candidate (easy-kill-get thing)))))
 415
 416 (put 'easy-kill-abort 'easy-kill-exit t)
 417 (defun easy-kill-abort ()
 418   (interactive)
 419   (when easy-kill-mark
 420     ;; The after-string may interfere with `goto-char'.
 421     (overlay-put (easy-kill-get origin-indicator) 'after-string nil)
 422     (goto-char (easy-kill-get origin))
 423     (setq deactivate-mark t))
 424   (ding))
 425
 426 (put 'easy-kill-region 'easy-kill-exit t)
 427 (defun easy-kill-region ()
 428   "Kill current selection and exit."
 429   (interactive "*")
 430   (pcase (easy-kill-get bounds)
 431     (`(,_x . ,_x) (easy-kill-echo "Empty region"))
 432     (`(,beg . ,end) (kill-region beg end))))
 433
 434 (put 'easy-kill-mark-region 'easy-kill-exit t)
 435 (defun easy-kill-mark-region ()
 436   (interactive)
 437   (pcase (easy-kill-get bounds)
 438     (`(,_x . ,_x)
 439      (easy-kill-echo "Empty region"))
 440     (`(,beg . ,end)
 441      (set-mark beg)
 442      (goto-char end)
 443      (activate-mark))))
 444
 445 (put 'easy-kill-append 'easy-kill-exit t)
 446 (defun easy-kill-append ()
 447   (interactive)
 448   (setq easy-kill-append t)
 449   (when (easy-kill-save-candidate)
 450     (easy-kill-interprogram-cut (car kill-ring))
 451     (setq deactivate-mark t)
 452     (easy-kill-echo "Appended")))
 453
 454 (defun easy-kill-exit-p (cmd)
 455   (and (symbolp cmd) (get cmd 'easy-kill-exit)))
 456
 457 (defun easy-kill-activate-keymap ()
 458   (let ((map (easy-kill-map)))
 459     (set-transient-map
 460      map
 461      (lambda ()
 462        ;; Prevent any error from activating the keymap forever.
 463        (condition-case err
 464            (or (and (not (easy-kill-exit-p this-command))
 465                     (or (eq this-command
 466                             (lookup-key map (this-single-command-keys)))
 467                         (let ((cmd (key-binding
 468                                     (this-single-command-keys) nil t)))
 469                           (command-remapping cmd nil (list map)))))
 470                (ignore
 471                 (easy-kill-destroy-candidate)
 472                 (unless (or easy-kill-mark (easy-kill-exit-p this-command))
 473                   (easy-kill-save-candidate))))
 474          (error (message "%s:%s" this-command (error-message-string err))
 475                 nil))))))
 476
 477 ;;;###autoload
 478 (defun easy-kill (&optional n)
 479   "Kill thing at point in the order of region, url, email and line.
 480 Temporally activate additional key bindings as follows:
 481
 482   letters => select or expand selection according to `easy-kill-alist';
 483   0..9    => expand selection by that number;
 484   +,=/-   => expand or shrink selection;
 485   @       => append selection to previous kill;
 486   C-w     => kill selection;
 487   C-SPC   => turn selection into an active region;
 488   C-g     => abort;
 489   others  => save selection and exit."
 490   (interactive "p")
 491   (if (use-region-p)
 492       (if (fboundp 'rectangle-mark-mode) ; New in 24.4
 493           (with-no-warnings
 494             (kill-ring-save (region-beginning) (region-end) t))
 495         (kill-ring-save (region-beginning) (region-end)))
 496     (setq easy-kill-mark nil)
 497     (setq easy-kill-append (eq last-command 'kill-region))
 498     (easy-kill-init-candidate n)
 499     (when (zerop (buffer-size))
 500       (easy-kill-echo "Warn: `easy-kill' activated in empty buffer"))
 501     (easy-kill-activate-keymap)))
 502
 503 ;;;###autoload
 504 (defalias 'easy-mark-sexp 'easy-mark
 505   "Use `easy-mark' instead. The alias may be removed in future.")
 506
 507 ;;;###autoload
 508 (defun easy-mark (&optional n)
 509   "Similar to `easy-kill' (which see) but for marking."
 510   (interactive "p")
 511   (let ((easy-kill-try-things easy-mark-try-things))
 512     (setq easy-kill-mark t)
 513     (easy-kill-init-candidate n)
 514     (easy-kill-activate-keymap)
 515     (unless (easy-kill-get thing)
 516       (setf (easy-kill-get thing) 'sexp)
 517       (easy-kill-thing 'sexp n))))
 518
 519 ;;;; Extended things
 520
 521 ;;; Handler for `buffer-file-name'.
 522
 523 (defun easy-kill-on-buffer-file-name (n)
 524   "Get `buffer-file-name' or `default-directory'.
 525 If N is zero, remove the directory part; -, remove the file name
 526 part; +, full path."
 527   (if easy-kill-mark
 528       (easy-kill-echo "Not supported in `easy-mark'")
 529     (pcase (or buffer-file-name default-directory)
 530       (`nil (easy-kill-echo "No `buffer-file-name'"))
 531       (file (let* ((file (directory-file-name file))
 532                    (text (pcase n
 533                            (`- (file-name-directory file))
 534                            (`0 (file-name-nondirectory file))
 535                            (_ file))))
 536               (easy-kill-adjust-candidate 'buffer-file-name text))))))
 537
 538 ;;; Handler for `defun-name'.
 539
 540 (defun easy-kill-on-defun-name (_n)
 541   "Get current defun name."
 542   (if easy-kill-mark
 543       (easy-kill-echo "Not supported in `easy-mark'")
 544     (pcase (add-log-current-defun)
 545       (`nil (easy-kill-echo "No `defun-name' at point"))
 546       (name (easy-kill-adjust-candidate 'defun-name name)))))
 547
 548 ;;; Handler for `url'.
 549
 550 (defun easy-kill-on-url (&optional _n)
 551   "Get url at point or from char properties.
 552 Char properties `help-echo', `shr-url' and `w3m-href-anchor' are
 553 inspected."
 554   (if (or easy-kill-mark (bounds-of-thing-at-point 'url))
 555       (easy-kill-thing 'url nil t)
 556     (cl-labels ((get-url (text)
 557                          (when (stringp text)
 558                            (with-temp-buffer
 559                              (insert text)
 560                              (pcase (bounds-of-thing-at-point 'url)
 561                                (`(,beg . ,end) (buffer-substring beg end)))))))
 562       (cl-dolist (p '(help-echo shr-url w3m-href-anchor))
 563         (pcase (get-char-property-and-overlay (point) p)
 564           (`(,text . ,ov)
 565            (pcase (or (get-url text)
 566                       (get-url (and ov (overlay-get ov p))))
 567              ((and url (guard url))
 568               (easy-kill-adjust-candidate 'url url)
 569               (cl-return url)))))))))
 570
 571 ;;; Handler for `sexp' and `list'.
 572
 573 (defvar up-list-fn)                     ; Dynamically bound
 574
 575 (defun easy-kill-backward-up ()
 576   (let ((ppss (syntax-ppss)))
 577     (condition-case nil
 578         (progn
 579           (funcall (or (bound-and-true-p up-list-fn) #'up-list) -1)
 580           ;; `up-list' may jump to another string.
 581           (when (and (nth 3 ppss) (< (point) (nth 8 ppss)))
 582             (goto-char (nth 8 ppss))))
 583       (scan-error (and (nth 3 ppss) (goto-char (nth 8 ppss)))))))
 584
 585 (defun easy-kill-forward-down (point &optional bound)
 586   (condition-case nil
 587       (progn
 588         (easy-kill-backward-up)
 589         (backward-prefix-chars)
 590         (if (and (or (not bound) (> (point) bound))
 591                  (/= point (point)))
 592             (easy-kill-forward-down (point) bound)
 593           (goto-char point)))
 594     (scan-error (goto-char point))))
 595
 596 (defun easy-kill-bounds-of-list (n)
 597   (save-excursion
 598     (pcase n
 599       (`+ (goto-char (easy-kill-get start))
 600           (easy-kill-backward-up))
 601       (`- (easy-kill-forward-down (point) (easy-kill-get start)))
 602       (_ (error "Unsupported argument `%s'" n)))
 603     (bounds-of-thing-at-point 'sexp)))
 604
 605 (defun easy-kill-on-list (n)
 606   (pcase n
 607     ((or `+ `-)
 608      (pcase (easy-kill-bounds-of-list n)
 609        (`(,beg . ,end)
 610         (easy-kill-adjust-candidate 'list beg end))))
 611     (_ (easy-kill-thing 'list n t))))
 612
 613 (defun easy-kill-on-sexp (n)
 614   (pcase n
 615     ((or `+ `-)
 616      (unwind-protect (easy-kill-thing 'list n)
 617        (setf (easy-kill-get thing) 'sexp)))
 618     (_ (easy-kill-thing 'sexp n t))))
 619
 620 ;;; nxml support for list-wise +/-
 621
 622 (defvar nxml-sexp-element-flag)
 623
 624 (defun easy-kill-on-list:nxml (n)
 625   (let ((nxml-sexp-element-flag t)
 626         (up-list-fn 'nxml-up-element))
 627     (cond
 628      ((memq n '(+ -))
 629       (pcase (easy-kill-bounds-of-list n)
 630         (`(,beg . ,end) (easy-kill-adjust-candidate 'list beg end))))
 631      ((eq 'list (easy-kill-get thing))
 632       (let ((new-end (save-excursion
 633                        (goto-char (easy-kill-get end))
 634                        (forward-sexp n)
 635                        (point))))
 636         (when (and new-end (/= new-end (easy-kill-get end)))
 637           (easy-kill-adjust-candidate 'list nil new-end))))
 638      (t (save-excursion
 639           (ignore-errors (easy-kill-backward-up))
 640           (easy-kill-thing 'sexp n t)
 641           (setf (easy-kill-get thing) 'list))))))
 642
 643 ;;; js2 support for list-wise +/-
 644
 645 (defun easy-kill-find-js2-node (beg end &optional inner)
 646   (eval-and-compile (require 'js2-mode nil t))
 647   (let* ((node (js2-node-at-point))
 648          (last-node node))
 649     (while (progn
 650              (if (or (js2-ast-root-p node)
 651                      (and (<= (js2-node-abs-pos node) beg)
 652                           (>= (js2-node-abs-end node) end)
 653                           (or inner
 654                               (not (and (= (js2-node-abs-pos node) beg)
 655                                         (= (js2-node-abs-end node) end))))))
 656                  nil
 657                (setq last-node node
 658                      node (js2-node-parent node))
 659                t)))
 660     (if inner last-node node)))
 661
 662 (defun easy-kill-on-list:js2 (n)
 663   (let ((node (pcase n
 664                 ((or `+ `-)
 665                  (easy-kill-find-js2-node (easy-kill-get start)
 666                                           (easy-kill-get end)
 667                                           (eq n '-)))
 668                 ((guard (eq 'list (easy-kill-get thing)))
 669                  (error "List forward not supported in js2-mode"))
 670                 (_ (js2-node-at-point)))))
 671     (easy-kill-adjust-candidate 'list
 672                                 (js2-node-abs-pos node)
 673                                 (js2-node-abs-end node))
 674     (setf (easy-kill-get describe-thing)
 675           ;; Also used by `sexp' so delay computation until needed.
 676           (lambda ()
 677             (format "%s (%s)" (easy-kill-get thing) (js2-node-short-name node))))
 678     (easy-kill-echo "%s" (js2-node-short-name node))))
 679
 680 (provide 'easy-kill)
 681 ;;; easy-kill.el ends here