diff options
Diffstat (limited to '.config/emacs/lisp/expand-region/expand-region-core.el')
| -rw-r--r-- | .config/emacs/lisp/expand-region/expand-region-core.el | 322 |
1 files changed, 0 insertions, 322 deletions
diff --git a/.config/emacs/lisp/expand-region/expand-region-core.el b/.config/emacs/lisp/expand-region/expand-region-core.el deleted file mode 100644 index c239fd1..0000000 --- a/.config/emacs/lisp/expand-region/expand-region-core.el +++ /dev/null @@ -1,322 +0,0 @@ -;;; expand-region-core.el --- Increase selected region by semantic units. -*- lexical-binding: t; -*- - -;; Copyright (C) 2011-2023 Free Software Foundation, Inc - -;; Author: Magnar Sveen <magnars@gmail.com> -;; Keywords: marking region - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; The core functionality of expand-region. - -;; See README.md - -;;; Code: - -(require 'expand-region-custom) -(declare-function er/expand-region "expand-region") - -(defvar er/history '() - "A history of start and end points so we can contract after expanding.") - -;; history is always local to a single buffer -(make-variable-buffer-local 'er/history) - -(defvar er--space-str " \t\n") -(defvar er--blank-list (append er--space-str nil)) - -(defvar er--show-expansion-message nil) - -(defvar er/try-expand-list nil - "A list of functions that are tried when expanding.") - -(defvar er/save-mode-excursion nil - "A function to save excursion state when expanding.") - -(defsubst er--first-invocation () - "t if this is the first invocation of `er/expand-region' or `er/contract-region'." - (not (memq last-command '(er/expand-region er/contract-region)))) - -(defun er--prepare-expanding () - (when (and (er--first-invocation) - (not (use-region-p))) - (push-mark nil t) ;; one for keeping starting position - (push-mark nil t)) ;; one for replace by set-mark in expansions - - (when (not transient-mark-mode) - (setq-local transient-mark-mode (cons 'only transient-mark-mode)))) - -(defun er--copy-region-to-register () - (when (and (stringp expand-region-autocopy-register) - (> (length expand-region-autocopy-register) 0)) - (set-register (aref expand-region-autocopy-register 0) - (filter-buffer-substring (region-beginning) (region-end))))) - -;; save-mark-and-excursion in Emacs 25 works like save-excursion did before -(eval-when-compile - (when (< emacs-major-version 25) - (defmacro save-mark-and-excursion (&rest body) - `(save-excursion ,@body)))) - -(defmacro er--save-excursion (&rest body) - `(let ((action (lambda () - (save-mark-and-excursion ,@body)))) - (if er/save-mode-excursion - (funcall er/save-mode-excursion action) - (funcall action)))) - -(defun er--expand-region-1 () - "Increase selected region by semantic units. -Basically it runs all the mark-functions in `er/try-expand-list' -and chooses the one that increases the size of the region while -moving point or mark as little as possible." - (let* ((p1 (point)) - (p2 (if (use-region-p) (mark) (point))) - (start (min p1 p2)) - (end (max p1 p2)) - (try-list er/try-expand-list) - (best-start (point-min)) - (best-end (point-max)) - ;; (set-mark-default-inactive nil) - ) - - ;; add hook to clear history on buffer changes - (unless er/history - (add-hook 'after-change-functions #'er/clear-history t t)) - - ;; remember the start and end points so we can contract later - ;; unless we're already at maximum size - (unless (and (= start best-start) - (= end best-end)) - (push (cons p1 p2) er/history)) - - (when (and expand-region-skip-whitespace - (er--point-is-surrounded-by-white-space) - (= start end)) - (skip-chars-forward er--space-str) - (setq start (point))) - - (while try-list - (er--save-excursion - (ignore-errors - (funcall (car try-list)) - (when (and (region-active-p) - (er--this-expansion-is-better start end best-start best-end)) - (setq best-start (point)) - (setq best-end (mark)) - (when (and er--show-expansion-message (not (minibufferp))) - (message "%S" (car try-list)))))) - (setq try-list (cdr try-list))) - - (setq deactivate-mark nil) - ;; if smart cursor enabled, decide to put it at start or end of region: - (if (and expand-region-smart-cursor - (not (= start best-start))) - (progn (goto-char best-end) - (set-mark best-start)) - (goto-char best-start) - (set-mark best-end)) - - (er--copy-region-to-register) - - (when (and (= best-start (point-min)) - (= best-end (point-max))) ;; We didn't find anything new, so exit early - 'early-exit))) - -(defun er--this-expansion-is-better (start end best-start best-end) - "t if the current region is an improvement on previous expansions. - -This is provided as a separate function for those that would like -to override the heuristic." - (and - (<= (point) start) - (>= (mark) end) - (> (- (mark) (point)) (- end start)) - (or (> (point) best-start) - (and (= (point) best-start) - (< (mark) best-end))))) - -;;;###autoload -(defun er/contract-region (arg) - "Contract the selected region to its previous size. -With prefix argument contracts that many times. -If prefix argument is negative calls `er/expand-region'. -If prefix argument is 0 it resets point and mark to their state -before calling `er/expand-region' for the first time." - (interactive "p") - (if (< arg 0) - (er/expand-region (- arg)) - (when er/history - ;; Be sure to reset them all if called with 0 - (when (= arg 0) - (setq arg (length er/history))) - - (when (not transient-mark-mode) - (setq-local transient-mark-mode (cons 'only transient-mark-mode))) - - ;; Advance through the list the desired distance - (while (and (cdr er/history) - (> arg 1)) - (setq arg (- arg 1)) - (setq er/history (cdr er/history))) - ;; Reset point and mark - (let* ((last (pop er/history)) - (start (car last)) - (end (cdr last))) - (goto-char start) - (set-mark end) - - (er--copy-region-to-register) - - (when (eq start end) - (deactivate-mark) - (er/clear-history)))))) - -(defun er/prepare-for-more-expansions-internal (repeat-key-str) - "Return bindings and a message to inform user about them" - (let ((msg (format "Type %s to expand again" repeat-key-str)) - (bindings (list (cons repeat-key-str '(er/expand-region 1))))) - ;; If contract and expand are on the same binding, ignore contract - (unless (string-equal repeat-key-str expand-region-contract-fast-key) - (setq msg (concat msg (format ", %s to contract" expand-region-contract-fast-key))) - (push (cons expand-region-contract-fast-key '(er/contract-region 1)) bindings)) - ;; If reset and either expand or contract are on the same binding, ignore reset - (unless (or (string-equal repeat-key-str expand-region-reset-fast-key) - (string-equal expand-region-contract-fast-key expand-region-reset-fast-key)) - (setq msg (concat msg (format ", %s to reset" expand-region-reset-fast-key))) - (push (cons expand-region-reset-fast-key '(er/expand-region 0)) bindings)) - (cons msg bindings))) - -(defun er/prepare-for-more-expansions () - "Let one expand more by just pressing the last key." - (let* ((repeat-key (event-basic-type last-input-event)) - (repeat-key-str (single-key-description repeat-key)) - (msg-and-bindings (er/prepare-for-more-expansions-internal repeat-key-str)) - (msg (car msg-and-bindings)) - (bindings (cdr msg-and-bindings))) - (when repeat-key - (er/set-temporary-overlay-map - (let ((map (make-sparse-keymap))) - (dolist (binding bindings map) - (define-key map (read-kbd-macro (car binding)) - `(lambda () - (interactive) - (setq this-command `,(cadr ',binding)) - (or (not expand-region-show-usage-message) (minibufferp) (message "%s" ,msg)) - (eval `,(cdr ',binding)))))) - t) - (or (not expand-region-show-usage-message) (minibufferp) (message "%s" msg))))) - -(defalias 'er/set-temporary-overlay-map - (if (fboundp 'set-temporary-overlay-map) ;Emacsā„24.3 - #'set-temporary-overlay-map - ;; Backport this function from newer emacs versions - (lambda (map &optional keep-pred) - "Set a new keymap that will only exist for a short period of time. -The new keymap to use must be given in the MAP variable. When to -remove the keymap depends on user input and KEEP-PRED: - -- if KEEP-PRED is nil (the default), the keymap disappears as - soon as any key is pressed, whether or not the key is in MAP; - -- if KEEP-PRED is t, the keymap disappears as soon as a key *not* - in MAP is pressed; - -- otherwise, KEEP-PRED must be a 0-arguments predicate that will - decide if the keymap should be removed (if predicate returns - nil) or kept (otherwise). The predicate will be called after - each key sequence." - - (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) - (overlaysym (make-symbol "t")) - (alist (list (cons overlaysym map))) - (clearfun - `(lambda () - (unless ,(cond ((null keep-pred) nil) - ((eq t keep-pred) - `(eq this-command - (lookup-key ',map - (this-command-keys-vector)))) - (t `(funcall ',keep-pred))) - (remove-hook 'pre-command-hook ',clearfunsym) - (setq emulation-mode-map-alists - (delq ',alist emulation-mode-map-alists)))))) - (set overlaysym overlaysym) - (fset clearfunsym clearfun) - (add-hook 'pre-command-hook clearfunsym) - - (push alist emulation-mode-map-alists))))) - -(advice-add 'keyboard-quit :before #'er--collapse-region-before) -(advice-add 'cua-cancel :before #'er--collapse-region-before) -(defun er--collapse-region-before (&rest _) - ;; FIXME: Re-use `er--first-invocation'? - (when (memq last-command '(er/expand-region er/contract-region)) - (er/contract-region 0))) - -(advice-add 'minibuffer-keyboard-quit - :around #'er--collapse-region-minibuffer-keyboard-quit) -(defun er--collapse-region-minibuffer-keyboard-quit (orig-fun &rest args) - ;; FIXME: Re-use `er--first-invocation'? - (if (memq last-command '(er/expand-region er/contract-region)) - (er/contract-region 0) - (apply orig-fun args))) - - -(defun er/clear-history (&rest _) - "Clear the history." - (setq er/history '()) - (remove-hook 'after-change-functions #'er/clear-history t)) - -(defun er--point-is-surrounded-by-white-space () - (and (or (memq (char-before) er--blank-list) - (eq (point) (point-min))) - (memq (char-after) er--blank-list))) - -(defun er/enable-mode-expansions (mode add-fn) - (add-hook (intern (format "%s-hook" mode)) add-fn) - (save-window-excursion ;; FIXME: Why? - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (derived-mode-p mode) - (funcall add-fn)))))) - -(defun er/enable-minor-mode-expansions (mode add-fn) - (add-hook (intern (format "%s-hook" mode)) add-fn) - (save-window-excursion - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (symbol-value mode) - (funcall add-fn)))))) - -;; Some more performant version of `looking-back' - -(defun er/looking-back-on-line (regexp) - "Version of `looking-back' that only checks current line." - (looking-back regexp (line-beginning-position))) - -(defun er/looking-back-exact (s) - "Version of `looking-back' that only looks for exact matches, no regexp." - (string= s (buffer-substring (- (point) (length s)) - (point)))) - -(defun er/looking-back-max (regexp count) - "Version of `looking-back' that only check COUNT chars back." - (looking-back regexp (max 1 (- (point) count)))) - -(provide 'expand-region-core) - -;;; expand-region-core.el ends here |