Daniel Borchmann
3 years ago
31 changed files with 8786 additions and 0 deletions
@ -0,0 +1,393 @@
|
||||
;;; hydra-examples.el --- Some applications for Hydra |
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc. |
||||
|
||||
;; Author: Oleh Krehel |
||||
|
||||
;; This file is part of GNU Emacs. |
||||
|
||||
;; GNU Emacs 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. |
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
||||
|
||||
;;; Commentary: |
||||
;; |
||||
;; These are the sample Hydras. |
||||
;; |
||||
;; If you want to use them plainly, set `hydra-examples-verbatim' to t |
||||
;; before requiring this file. But it's probably better to only look |
||||
;; at them and use them as templates for building your own. |
||||
|
||||
;;; Code: |
||||
|
||||
(require 'hydra) |
||||
|
||||
;;* Examples |
||||
;;** Example 1: text scale |
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(defhydra hydra-zoom (global-map "<f2>") |
||||
"zoom" |
||||
("g" text-scale-increase "in") |
||||
("l" text-scale-decrease "out"))) |
||||
|
||||
;; This example generates three commands: |
||||
;; |
||||
;; `hydra-zoom/text-scale-increase' |
||||
;; `hydra-zoom/text-scale-decrease' |
||||
;; `hydra-zoom/body' |
||||
;; |
||||
;; In addition, two of them are bound like this: |
||||
;; |
||||
;; (global-set-key (kbd "<f2> g") 'hydra-zoom/text-scale-increase) |
||||
;; (global-set-key (kbd "<f2> l") 'hydra-zoom/text-scale-decrease) |
||||
;; |
||||
;; Note that you can substitute `global-map' with e.g. `emacs-lisp-mode-map' if you need. |
||||
;; The functions generated will be the same, except the binding code will change to: |
||||
;; |
||||
;; (define-key emacs-lisp-mode-map [f2 103] |
||||
;; (function hydra-zoom/text-scale-increase)) |
||||
;; (define-key emacs-lisp-mode-map [f2 108] |
||||
;; (function hydra-zoom/text-scale-decrease)) |
||||
|
||||
;;** Example 2: move window splitter |
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(defhydra hydra-splitter (global-map "C-M-s") |
||||
"splitter" |
||||
("h" hydra-move-splitter-left) |
||||
("j" hydra-move-splitter-down) |
||||
("k" hydra-move-splitter-up) |
||||
("l" hydra-move-splitter-right))) |
||||
|
||||
;;** Example 3: jump to error |
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(defhydra hydra-error (global-map "M-g") |
||||
"goto-error" |
||||
("h" first-error "first") |
||||
("j" next-error "next") |
||||
("k" previous-error "prev") |
||||
("v" recenter-top-bottom "recenter") |
||||
("q" nil "quit"))) |
||||
|
||||
;; This example introduces only one new thing: since the command |
||||
;; passed to the "q" head is nil, it will quit the Hydra without doing |
||||
;; anything. Heads that quit the Hydra instead of continuing are |
||||
;; referred to as having blue :color. All the other heads have red |
||||
;; :color, unless other is specified. |
||||
|
||||
;;** Example 4: toggle rarely used modes |
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(defvar whitespace-mode nil) |
||||
(global-set-key |
||||
(kbd "C-c C-v") |
||||
(defhydra hydra-toggle-simple (:color blue) |
||||
"toggle" |
||||
("a" abbrev-mode "abbrev") |
||||
("d" toggle-debug-on-error "debug") |
||||
("f" auto-fill-mode "fill") |
||||
("t" toggle-truncate-lines "truncate") |
||||
("w" whitespace-mode "whitespace") |
||||
("q" nil "cancel")))) |
||||
|
||||
;; Note that in this case, `defhydra' returns the `hydra-toggle-simple/body' |
||||
;; symbol, which is then passed to `global-set-key'. |
||||
;; |
||||
;; Another new thing is that both the keymap and the body prefix are |
||||
;; skipped. This means that `defhydra' will bind nothing - that's why |
||||
;; `global-set-key' is necessary. |
||||
;; |
||||
;; One more new thing is that you can assign a :color to the body. All |
||||
;; heads will inherit this color. The code above is very much equivalent to: |
||||
;; |
||||
;; (global-set-key (kbd "C-c C-v a") 'abbrev-mode) |
||||
;; (global-set-key (kbd "C-c C-v d") 'toggle-debug-on-error) |
||||
;; |
||||
;; The differences are: |
||||
;; |
||||
;; * You get a hint immediately after "C-c C-v" |
||||
;; * You can cancel and call a command immediately, e.g. "C-c C-v C-n" |
||||
;; is equivalent to "C-n" with Hydra approach, while it will error |
||||
;; that "C-c C-v C-n" isn't bound with the usual approach. |
||||
|
||||
;;** Example 5: mini-vi |
||||
(defun hydra-vi/pre () |
||||
(set-cursor-color "#e52b50")) |
||||
|
||||
(defun hydra-vi/post () |
||||
(set-cursor-color "#ffffff")) |
||||
|
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(global-set-key |
||||
(kbd "C-z") |
||||
(defhydra hydra-vi (:pre hydra-vi/pre :post hydra-vi/post :color amaranth) |
||||
"vi" |
||||
("l" forward-char) |
||||
("h" backward-char) |
||||
("j" next-line) |
||||
("k" previous-line) |
||||
("m" set-mark-command "mark") |
||||
("a" move-beginning-of-line "beg") |
||||
("e" move-end-of-line "end") |
||||
("d" delete-region "del" :color blue) |
||||
("y" kill-ring-save "yank" :color blue) |
||||
("q" nil "quit"))) |
||||
(hydra-set-property 'hydra-vi :verbosity 1)) |
||||
|
||||
;; This example introduces :color amaranth. It's similar to red, |
||||
;; except while you can quit red with any binding which isn't a Hydra |
||||
;; head, you can quit amaranth only with a blue head. So you can quit |
||||
;; this mode only with "d", "y", "q" or "C-g". |
||||
;; |
||||
;; Another novelty are the :pre and :post handlers. :pre will be |
||||
;; called before each command, while :post will be called when the |
||||
;; Hydra quits. In this case, they're used to override the cursor |
||||
;; color while Hydra is active. |
||||
|
||||
;;** Example 6: selective global bind |
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(defhydra hydra-next-error (global-map "C-x") |
||||
"next-error" |
||||
("`" next-error "next") |
||||
("j" next-error "next" :bind nil) |
||||
("k" previous-error "previous" :bind nil))) |
||||
|
||||
;; This example will bind "C-x `" in `global-map', but it will not |
||||
;; bind "C-x j" and "C-x k". |
||||
;; You can still "C-x `jjk" though. |
||||
|
||||
;;** Example 7: toggle with Ruby-style docstring |
||||
(defvar whitespace-mode nil) |
||||
(defhydra hydra-toggle (:color pink) |
||||
" |
||||
_a_ abbrev-mode: %`abbrev-mode |
||||
_d_ debug-on-error: %`debug-on-error |
||||
_f_ auto-fill-mode: %`auto-fill-function |
||||
_t_ truncate-lines: %`truncate-lines |
||||
_w_ whitespace-mode: %`whitespace-mode |
||||
|
||||
" |
||||
("a" abbrev-mode nil) |
||||
("d" toggle-debug-on-error nil) |
||||
("f" auto-fill-mode nil) |
||||
("t" toggle-truncate-lines nil) |
||||
("w" whitespace-mode nil) |
||||
("q" nil "quit")) |
||||
;; Recommended binding: |
||||
;; (global-set-key (kbd "C-c C-v") 'hydra-toggle/body) |
||||
|
||||
;; Here, using e.g. "_a_" translates to "a" with proper face. |
||||
;; More interestingly: |
||||
;; |
||||
;; "foobar %`abbrev-mode" means roughly (format "foobar %S" abbrev-mode) |
||||
;; |
||||
;; This means that you actually see the state of the mode that you're changing. |
||||
|
||||
;;** Example 8: the whole menu for `Buffer-menu-mode' |
||||
(defhydra hydra-buffer-menu (:color pink |
||||
:hint nil) |
||||
" |
||||
^Mark^ ^Unmark^ ^Actions^ ^Search |
||||
^^^^^^^^----------------------------------------------------------------- (__) |
||||
_m_: mark _u_: unmark _x_: execute _R_: re-isearch (oo) |
||||
_s_: save _U_: unmark up _b_: bury _I_: isearch /------\\/ |
||||
_d_: delete ^ ^ _g_: refresh _O_: multi-occur / | || |
||||
_D_: delete up ^ ^ _T_: files only: % -28`Buffer-menu-files-only^^ * /\\---/\\ |
||||
_~_: modified ^ ^ ^ ^ ^^ ~~ ~~ |
||||
" |
||||
("m" Buffer-menu-mark) |
||||
("u" Buffer-menu-unmark) |
||||
("U" Buffer-menu-backup-unmark) |
||||
("d" Buffer-menu-delete) |
||||
("D" Buffer-menu-delete-backwards) |
||||
("s" Buffer-menu-save) |
||||
("~" Buffer-menu-not-modified) |
||||
("x" Buffer-menu-execute) |
||||
("b" Buffer-menu-bury) |
||||
("g" revert-buffer) |
||||
("T" Buffer-menu-toggle-files-only) |
||||
("O" Buffer-menu-multi-occur :color blue) |
||||
("I" Buffer-menu-isearch-buffers :color blue) |
||||
("R" Buffer-menu-isearch-buffers-regexp :color blue) |
||||
("c" nil "cancel") |
||||
("v" Buffer-menu-select "select" :color blue) |
||||
("o" Buffer-menu-other-window "other-window" :color blue) |
||||
("q" quit-window "quit" :color blue)) |
||||
;; Recommended binding: |
||||
;; (define-key Buffer-menu-mode-map "." 'hydra-buffer-menu/body) |
||||
|
||||
;;** Example 9: s-expressions in the docstring |
||||
;; You can inline s-expresssions into the docstring like this: |
||||
(defvar dired-mode-map) |
||||
(declare-function dired-mark "dired") |
||||
(when (bound-and-true-p hydra-examples-verbatim) |
||||
(require 'dired) |
||||
(defhydra hydra-marked-items (dired-mode-map "") |
||||
" |
||||
Number of marked items: %(length (dired-get-marked-files)) |
||||
" |
||||
("m" dired-mark "mark"))) |
||||
|
||||
;; This results in the following dynamic docstring: |
||||
;; |
||||
;; (format "Number of marked items: %S\n" |
||||
;; (length (dired-get-marked-files))) |
||||
;; |
||||
;; You can use `format'-style width specs, e.g. % 10(length nil). |
||||
|
||||
;;** Example 10: apropos family |
||||
(defhydra hydra-apropos (:color blue |
||||
:hint nil) |
||||
" |
||||
_a_propos _c_ommand |
||||
_d_ocumentation _l_ibrary |
||||
_v_ariable _u_ser-option |
||||
^ ^ valu_e_" |
||||
("a" apropos) |
||||
("d" apropos-documentation) |
||||
("v" apropos-variable) |
||||
("c" apropos-command) |
||||
("l" apropos-library) |
||||
("u" apropos-user-option) |
||||
("e" apropos-value)) |
||||
;; Recommended binding: |
||||
;; (global-set-key (kbd "C-c h") 'hydra-apropos/body) |
||||
|
||||
;;** Example 11: rectangle-mark-mode |
||||
(require 'rect) |
||||
(defhydra hydra-rectangle (:body-pre (rectangle-mark-mode 1) |
||||
:color pink |
||||
:post (deactivate-mark)) |
||||
" |
||||
^_k_^ _d_elete _s_tring |
||||
_h_ _l_ _o_k _y_ank |
||||
^_j_^ _n_ew-copy _r_eset |
||||
^^^^ _e_xchange _u_ndo |
||||
^^^^ ^ ^ _x_kill |
||||
" |
||||
("h" rectangle-backward-char nil) |
||||
("l" rectangle-forward-char nil) |
||||
("k" rectangle-previous-line nil) |
||||
("j" rectangle-next-line nil) |
||||
("e" hydra-ex-point-mark nil) |
||||
("n" copy-rectangle-as-kill nil) |
||||
("d" delete-rectangle nil) |
||||
("r" (if (region-active-p) |
||||
(deactivate-mark) |
||||
(rectangle-mark-mode 1)) nil) |
||||
("y" yank-rectangle nil) |
||||
("u" undo nil) |
||||
("s" string-rectangle nil) |
||||
("x" kill-rectangle nil) |
||||
("o" nil nil)) |
||||
|
||||
;; Recommended binding: |
||||
;; (global-set-key (kbd "C-x SPC") 'hydra-rectangle/body) |
||||
|
||||
;;** Example 12: org-agenda-view |
||||
(defun org-agenda-cts () |
||||
(and (eq major-mode 'org-agenda-mode) |
||||
(let ((args (get-text-property |
||||
(min (1- (point-max)) (point)) |
||||
'org-last-args))) |
||||
(nth 2 args)))) |
||||
|
||||
(defhydra hydra-org-agenda-view (:hint none) |
||||
" |
||||
_d_: ?d? day _g_: time grid=?g? _a_: arch-trees |
||||
_w_: ?w? week _[_: inactive _A_: arch-files |
||||
_t_: ?t? fortnight _f_: follow=?f? _r_: clock report=?r? |
||||
_m_: ?m? month _e_: entry text=?e? _D_: include diary=?D? |
||||
_y_: ?y? year _q_: quit _L__l__c_: log = ?l?" |
||||
("SPC" org-agenda-reset-view) |
||||
("d" org-agenda-day-view (if (eq 'day (org-agenda-cts)) "[x]" "[ ]")) |
||||
("w" org-agenda-week-view (if (eq 'week (org-agenda-cts)) "[x]" "[ ]")) |
||||
("t" org-agenda-fortnight-view (if (eq 'fortnight (org-agenda-cts)) "[x]" "[ ]")) |
||||
("m" org-agenda-month-view (if (eq 'month (org-agenda-cts)) "[x]" "[ ]")) |
||||
("y" org-agenda-year-view (if (eq 'year (org-agenda-cts)) "[x]" "[ ]")) |
||||
("l" org-agenda-log-mode (format "% -3S" org-agenda-show-log)) |
||||
("L" (org-agenda-log-mode '(4))) |
||||
("c" (org-agenda-log-mode 'clockcheck)) |
||||
("f" org-agenda-follow-mode (format "% -3S" org-agenda-follow-mode)) |
||||
("a" org-agenda-archives-mode) |
||||
("A" (org-agenda-archives-mode 'files)) |
||||
("r" org-agenda-clockreport-mode (format "% -3S" org-agenda-clockreport-mode)) |
||||
("e" org-agenda-entry-text-mode (format "% -3S" org-agenda-entry-text-mode)) |
||||
("g" org-agenda-toggle-time-grid (format "% -3S" org-agenda-use-time-grid)) |
||||
("D" org-agenda-toggle-diary (format "% -3S" org-agenda-include-diary)) |
||||
("!" org-agenda-toggle-deadlines) |
||||
("[" (let ((org-agenda-include-inactive-timestamps t)) |
||||
(org-agenda-check-type t 'timeline 'agenda) |
||||
(org-agenda-redo) |
||||
(message "Display now includes inactive timestamps as well"))) |
||||
("q" (message "Abort") :exit t) |
||||
("v" nil)) |
||||
|
||||
;; Recommended binding: |
||||
;; (define-key org-agenda-mode-map "v" 'hydra-org-agenda-view/body) |
||||
|
||||
;;** Example 13: automatic columns |
||||
(defhydra hydra-movement () |
||||
("j" next-line "down" :column "Vertical") |
||||
("k" previous-line "up") |
||||
("l" forward-char "forward" :column "Horizontal") |
||||
("h" backward-char "back")) |
||||
|
||||
;;* Helpers |
||||
(require 'windmove) |
||||
|
||||
(defun hydra-move-splitter-left (arg) |
||||
"Move window splitter left." |
||||
(interactive "p") |
||||
(if (let ((windmove-wrap-around)) |
||||
(windmove-find-other-window 'right)) |
||||
(shrink-window-horizontally arg) |
||||
(enlarge-window-horizontally arg))) |
||||
|
||||
(defun hydra-move-splitter-right (arg) |
||||
"Move window splitter right." |
||||
(interactive "p") |
||||
(if (let ((windmove-wrap-around)) |
||||
(windmove-find-other-window 'right)) |
||||
(enlarge-window-horizontally arg) |
||||
(shrink-window-horizontally arg))) |
||||
|
||||
(defun hydra-move-splitter-up (arg) |
||||
"Move window splitter up." |
||||
(interactive "p") |
||||
(if (let ((windmove-wrap-around)) |
||||
(windmove-find-other-window 'up)) |
||||
(enlarge-window arg) |
||||
(shrink-window arg))) |
||||
|
||||
(defun hydra-move-splitter-down (arg) |
||||
"Move window splitter down." |
||||
(interactive "p") |
||||
(if (let ((windmove-wrap-around)) |
||||
(windmove-find-other-window 'up)) |
||||
(shrink-window arg) |
||||
(enlarge-window arg))) |
||||
|
||||
(defvar rectangle-mark-mode) |
||||
(defun hydra-ex-point-mark () |
||||
"Exchange point and mark." |
||||
(interactive) |
||||
(if rectangle-mark-mode |
||||
(rectangle-exchange-point-and-mark) |
||||
(let ((mk (mark))) |
||||
(rectangle-mark-mode 1) |
||||
(goto-char mk)))) |
||||
|
||||
(provide 'hydra-examples) |
||||
|
||||
;; Local Variables: |
||||
;; no-byte-compile: t |
||||
;; End: |
||||
;;; hydra-examples.el ends here |
||||
@ -0,0 +1,127 @@
|
||||
;;; hydra-ox.el --- Org mode export widget implemented in Hydra |
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc. |
||||
|
||||
;; Author: Oleh Krehel |
||||
|
||||
;; This file is part of GNU Emacs. |
||||
|
||||
;; GNU Emacs 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. |
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
||||
|
||||
;;; Commentary: |
||||
;; |
||||
;; This shows how a complex dispatch menu can be built with Hydra. |
||||
|
||||
;;; Code: |
||||
|
||||
(require 'hydra) |
||||
(require 'org) |
||||
(declare-function org-html-export-as-html 'ox-html) |
||||
(declare-function org-html-export-to-html 'ox-html) |
||||
(declare-function org-latex-export-as-latex 'ox-latex) |
||||
(declare-function org-latex-export-to-latex 'ox-latex) |
||||
(declare-function org-latex-export-to-pdf 'ox-latex) |
||||
(declare-function org-ascii-export-as-ascii 'ox-ascii) |
||||
(declare-function org-ascii-export-to-ascii 'ox-ascii) |
||||
|
||||
(defhydradio hydra-ox () |
||||
(body-only "Export only the body.") |
||||
(export-scope "Export scope." [buffer subtree]) |
||||
(async-export "When non-nil, export async.") |
||||
(visible-only "When non-nil, export visible only") |
||||
(force-publishing "Toggle force publishing")) |
||||
|
||||
(defhydra hydra-ox-html (:color blue) |
||||
"ox-html" |
||||
("H" (org-html-export-as-html |
||||
hydra-ox/async-export |
||||
(eq hydra-ox/export-scope 'subtree) |
||||
hydra-ox/visible-only |
||||
hydra-ox/body-only) |
||||
"As HTML buffer") |
||||
("h" (org-html-export-to-html |
||||
hydra-ox/async-export |
||||
(eq hydra-ox/export-scope 'subtree) |
||||
hydra-ox/visible-only |
||||
hydra-ox/body-only) "As HTML file") |
||||
("o" (org-open-file |
||||
(org-html-export-to-html |
||||
hydra-ox/async-export |
||||
(eq hydra-ox/export-scope 'subtree) |
||||
hydra-ox/visible-only |
||||
hydra-ox/body-only)) "As HTML file and open") |
||||
("b" hydra-ox/body "back") |
||||
("q" nil "quit")) |
||||
|
||||
(defhydra hydra-ox-latex (:color blue) |
||||
"ox-latex" |
||||
("L" org-latex-export-as-latex "As LaTeX buffer") |
||||
("l" org-latex-export-to-latex "As LaTeX file") |
||||
("p" org-latex-export-to-pdf "As PDF file") |
||||
("o" (org-open-file (org-latex-export-to-pdf)) "As PDF file and open") |
||||
("b" hydra-ox/body "back") |
||||
("q" nil "quit")) |
||||
|
||||
(defhydra hydra-ox-text (:color blue) |
||||
"ox-text" |
||||
("A" (org-ascii-export-as-ascii |
||||
nil nil nil nil |
||||
'(:ascii-charset ascii)) |
||||
"As ASCII buffer") |
||||
|
||||
("a" (org-ascii-export-to-ascii |
||||
nil nil nil nil |
||||
'(:ascii-charset ascii)) |
||||
"As ASCII file") |
||||
("L" (org-ascii-export-as-ascii |
||||
nil nil nil nil |
||||
'(:ascii-charset latin1)) |
||||
"As Latin1 buffer") |
||||
("l" (org-ascii-export-to-ascii |
||||
nil nil nil nil |
||||
'(:ascii-charset latin1)) |
||||
"As Latin1 file") |
||||
("U" (org-ascii-export-as-ascii |
||||
nil nil nil nil |
||||
'(:ascii-charset utf-8)) |
||||
"As UTF-8 buffer") |
||||
("u" (org-ascii-export-to-ascii |
||||
nil nil nil nil |
||||
'(:ascii-charset utf-8)) |
||||
"As UTF-8 file") |
||||
("b" hydra-ox/body "back") |
||||
("q" nil "quit")) |
||||
|
||||
(defhydra hydra-ox () |
||||
" |
||||
_C-b_ Body only: % -15`hydra-ox/body-only^^^ _C-v_ Visible only: %`hydra-ox/visible-only |
||||
_C-s_ Export scope: % -15`hydra-ox/export-scope _C-f_ Force publishing: %`hydra-ox/force-publishing |
||||
_C-a_ Async export: %`hydra-ox/async-export |
||||
|
||||
" |
||||
("C-b" (hydra-ox/body-only) nil) |
||||
("C-v" (hydra-ox/visible-only) nil) |
||||
("C-s" (hydra-ox/export-scope) nil) |
||||
("C-f" (hydra-ox/force-publishing) nil) |
||||
("C-a" (hydra-ox/async-export) nil) |
||||
("h" hydra-ox-html/body "Export to HTML" :exit t) |
||||
("l" hydra-ox-latex/body "Export to LaTeX" :exit t) |
||||
("t" hydra-ox-text/body "Export to Plain Text" :exit t) |
||||
("q" nil "quit")) |
||||
|
||||
(define-key org-mode-map (kbd "C-c C-,") 'hydra-ox/body) |
||||
|
||||
(provide 'hydra-ox) |
||||
|
||||
;;; hydra-ox.el ends here |
||||
@ -0,0 +1,13 @@
|
||||
(define-package "hydra" "20191125.955" "Make bindings that stick around." |
||||
'((cl-lib "0.5") |
||||
(lv "0")) |
||||
:keywords |
||||
'("bindings") |
||||
:authors |
||||
'(("Oleh Krehel" . "ohwoeowho@gmail.com")) |
||||
:maintainer |
||||
'("Oleh Krehel" . "ohwoeowho@gmail.com") |
||||
:url "https://github.com/abo-abo/hydra") |
||||
;; Local Variables: |
||||
;; no-byte-compile: t |
||||
;; End: |
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,2 @@
|
||||
;;; -*- no-byte-compile: t -*- |
||||
(define-package "lv" "20191214.1357" "Other echo area" 'nil :commit "9db28034d7d61bfeff89899633b958f22befc53d" :authors '(("Oleh Krehel")) :maintainer '("Oleh Krehel")) |
||||
@ -0,0 +1,145 @@
|
||||
;;; lv.el --- Other echo area |
||||
;; Package-Version: 20191214.1357 |
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc. |
||||
|
||||
;; Author: Oleh Krehel |
||||
|
||||
;; This file is part of GNU Emacs. |
||||
|
||||
;; GNU Emacs 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. |
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
||||
|
||||
;;; Commentary: |
||||
;; |
||||
;; This package provides `lv-message' intended to be used in place of |
||||
;; `message' when semi-permanent hints are needed, in order to not |
||||
;; interfere with Echo Area. |
||||
;; |
||||
;; "ะฏ ัะธั
ะพ-ัะธั
ะพ ะฟiะดะณะปัะดะฐั, |
||||
;; ะ ัiัััั ัะพะฑi, ัะบ ะฑะฐัั ัะพ, |
||||
;; ะจะพ ัััะฐัะธัั i ะฝะต ะฟiะดะฟััะบะฐั, |
||||
;; ะ iะฝัi ะฟโััั ัะตะฑะต, ัะบ ะฒะพะดั ะฟiัะพะบ." |
||||
;; -- ะะฝะดััะน ะัะทัะผะตะฝะบะพ, L.V. |
||||
|
||||
;;; Code: |
||||
|
||||
(defgroup lv nil |
||||
"The other echo area." |
||||
:group 'minibuffer |
||||
:group 'hydra) |
||||
|
||||
(defcustom lv-use-separator nil |
||||
"Whether to draw a line between the LV window and the Echo Area." |
||||
:group 'lv |
||||
:type 'boolean) |
||||
|
||||
(defcustom lv-use-padding nil |
||||
"Whether to use horizontal padding in the LV window." |
||||
:group 'lv |
||||
:type 'boolean) |
||||
|
||||
(defface lv-separator |
||||
'((((class color) (background light)) :background "grey80") |
||||
(((class color) (background dark)) :background "grey30")) |
||||
"Face used to draw line between the lv window and the echo area. |
||||
This is only used if option `lv-use-separator' is non-nil. |
||||
Only the background color is significant." |
||||
:group 'lv) |
||||
|
||||
(defvar lv-wnd nil |
||||
"Holds the current LV window.") |
||||
|
||||
(defvar display-line-numbers) |
||||
(defvar display-fill-column-indicator) |
||||
(defvar tab-line-format) |
||||
|
||||
(defvar lv-window-hook nil |
||||
"Hook to run by `lv-window' when a new window is created.") |
||||
|
||||
(defun lv-window () |
||||
"Ensure that LV window is live and return it." |
||||
(if (window-live-p lv-wnd) |
||||
lv-wnd |
||||
(let ((ori (selected-window)) |
||||
buf) |
||||
(prog1 (setq lv-wnd |
||||
(select-window |
||||
(let ((ignore-window-parameters t)) |
||||
(split-window |
||||
(frame-root-window) -1 'below)))) |
||||
(if (setq buf (get-buffer " *LV*")) |
||||
(switch-to-buffer buf) |
||||
(switch-to-buffer " *LV*") |
||||
(set-window-hscroll lv-wnd 0) |
||||
(setq window-size-fixed t) |
||||
(setq mode-line-format nil) |
||||
(setq header-line-format nil) |
||||
(setq tab-line-format nil) |
||||
(setq cursor-type nil) |
||||
(setq display-line-numbers nil) |
||||
(setq display-fill-column-indicator nil) |
||||
(set-window-dedicated-p lv-wnd t) |
||||
(set-window-parameter lv-wnd 'no-other-window t) |
||||
(run-hooks 'lv-window-hook)) |
||||
(select-window ori))))) |
||||
|
||||
(defvar golden-ratio-mode) |
||||
|
||||
(defvar lv-force-update nil |
||||
"When non-nil, `lv-message' will refresh even for the same string.") |
||||
|
||||
(defun lv--pad-to-center (str width) |
||||
"Pad STR with spaces on the left to be centered to WIDTH." |
||||
(let* ((strs (split-string str "\n")) |
||||
(padding (make-string |
||||
(/ (- width (length (car strs))) 2) |
||||
?\ ))) |
||||
(mapconcat (lambda (s) (concat padding s)) strs "\n"))) |
||||
|
||||
(defun lv-message (format-string &rest args) |
||||
"Set LV window contents to (`format' FORMAT-STRING ARGS)." |
||||
(let* ((str (apply #'format format-string args)) |
||||
(n-lines (cl-count ?\n str)) |
||||
deactivate-mark |
||||
golden-ratio-mode) |
||||
(with-selected-window (lv-window) |
||||
(when lv-use-padding |
||||
(setq str (lv--pad-to-center str (window-width)))) |
||||
(unless (and (string= (buffer-string) str) |
||||
(null lv-force-update)) |
||||
(delete-region (point-min) (point-max)) |
||||
(insert str) |
||||
(when (and (window-system) lv-use-separator) |
||||
(unless (looking-back "\n" nil) |
||||
(insert "\n")) |
||||
(insert |
||||
(propertize "__" 'face 'lv-separator 'display '(space :height (1))) |
||||
(propertize "\n" 'face 'lv-separator 'line-height t))) |
||||
(set (make-local-variable 'window-min-height) n-lines) |
||||
(setq truncate-lines (> n-lines 1)) |
||||
(let ((window-resize-pixelwise t) |
||||
(window-size-fixed nil)) |
||||
(fit-window-to-buffer nil nil 1))) |
||||
(goto-char (point-min))))) |
||||
|
||||
(defun lv-delete-window () |
||||
"Delete LV window and kill its buffer." |
||||
(when (window-live-p lv-wnd) |
||||
(let ((buf (window-buffer lv-wnd))) |
||||
(delete-window lv-wnd) |
||||
(kill-buffer buf)))) |
||||
|
||||
(provide 'lv) |
||||
|
||||
;;; lv.el ends here |
||||
@ -0,0 +1,119 @@
|
||||
;;; mc-cycle-cursors.el |
||||
|
||||
;; Copyright (C) 2012-2016 Magnar Sveen |
||||
|
||||
;; Author: Magnar Sveen <magnars@gmail.com> |
||||
;; Keywords: editing cursors |
||||
|
||||
;; 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: |
||||
|
||||
;; This scrolls the buffer to center each cursor in turn. |
||||
;; Scroll down with C-v, scroll up with M-v |
||||
;; This is nice when you have cursors that's outside of your view. |
||||
|
||||
;;; Code: |
||||
|
||||
(require 'multiple-cursors-core) |
||||
|
||||
(defun mc/next-fake-cursor-after-point () |
||||
(let ((pos (point)) |
||||
(next-pos (1+ (point-max))) |
||||
next) |
||||
(mc/for-each-fake-cursor |
||||
(let ((cursor-pos (overlay-get cursor 'point))) |
||||
(when (and (< pos cursor-pos) |
||||
(< cursor-pos next-pos)) |
||||
(setq next-pos cursor-pos) |
||||
(setq next cursor)))) |
||||
next)) |
||||
|
||||
(defun mc/prev-fake-cursor-before-point () |
||||
(let ((pos (point)) |
||||
(prev-pos (1- (point-min))) |
||||
prev) |
||||
(mc/for-each-fake-cursor |
||||
(let ((cursor-pos (overlay-get cursor 'point))) |
||||
(when (and (> pos cursor-pos) |
||||
(> cursor-pos prev-pos)) |
||||
(setq prev-pos cursor-pos) |
||||
(setq prev cursor)))) |
||||
prev)) |
||||
|
||||
(defcustom mc/cycle-looping-behaviour 'continue |
||||
"What to do if asked to cycle beyond the last cursor or before the first cursor." |
||||
:type '(radio (const :tag "Loop around to beginning/end of document." continue) |
||||
(const :tag "Warn and then loop around." warn) |
||||
(const :tag "Signal an error." error) |
||||
(const :tag "Don't loop." stop)) |
||||
:group 'multiple-cursors) |
||||
|
||||
(defun mc/handle-loop-condition (error-message) |
||||
(cl-ecase mc/cycle-looping-behaviour |
||||
(error (error error-message)) |
||||
(warn (message error-message)) |
||||
(continue 'continue) |
||||
(stop 'stop))) |
||||
|
||||
(defun mc/first-fake-cursor-after (point) |
||||
"Very similar to mc/furthest-cursor-before-point, but ignores (mark) and (point)." |
||||
(let* ((cursors (mc/all-fake-cursors)) |
||||
(cursors-after-point (cl-remove-if (lambda (cursor) |
||||
(< (mc/cursor-beg cursor) point)) |
||||
cursors)) |
||||
(cursors-in-order (cl-sort cursors-after-point '< :key 'mc/cursor-beg))) |
||||
(car cursors-in-order))) |
||||
|
||||
(defun mc/last-fake-cursor-before (point) |
||||
"Very similar to mc/furthest-cursor-before-point, but ignores (mark) and (point)." |
||||
(let* ((cursors (mc/all-fake-cursors)) |
||||
(cursors-before-point (cl-remove-if (lambda (cursor) |
||||
(> (mc/cursor-end cursor) point)) |
||||
cursors)) |
||||
(cursors-in-order (cl-sort cursors-before-point '> :key 'mc/cursor-end))) |
||||
(car cursors-in-order))) |
||||
|
||||
(cl-defun mc/cycle (next-cursor fallback-cursor loop-message) |
||||
(when (null next-cursor) |
||||
(when (eql 'stop (mc/handle-loop-condition loop-message)) |
||||
(return-from mc/cycle nil)) |
||||
(setf next-cursor fallback-cursor)) |
||||
(mc/create-fake-cursor-at-point) |
||||
(mc/pop-state-from-overlay next-cursor) |
||||
(recenter)) |
||||
|
||||
(defun mc/cycle-forward () |
||||
(interactive) |
||||
(mc/cycle (mc/next-fake-cursor-after-point) |
||||
(mc/first-fake-cursor-after (point-min)) |
||||
"We're already at the last cursor.")) |
||||
|
||||
(defun mc/cycle-backward () |
||||
(interactive) |
||||
(mc/cycle (mc/prev-fake-cursor-before-point) |
||||
(mc/last-fake-cursor-before (point-max)) |
||||
"We're already at the last cursor")) |
||||
|
||||
(define-key mc/keymap (kbd "C-v") 'mc/cycle-forward) |
||||
(define-key mc/keymap (kbd "M-v") 'mc/cycle-backward) |
||||
|
||||
(provide 'mc-cycle-cursors) |
||||
|
||||
|
||||
;; Local Variables: |
||||
;; coding: utf-8 |
||||
;; End: |
||||
|
||||
;;; mc-cycle-cursors.el ends here |
||||
@ -0,0 +1,110 @@
|
||||
;;; mc-edit-lines.el |
||||
|
||||
;; Copyright (C) 2012-2016 Magnar Sveen |
||||
|
||||
;; Author: Magnar Sveen <magnars@gmail.com> |
||||
;; Keywords: editing cursors |
||||
|
||||
;; 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: |
||||
|
||||
;; This file contains functions to add multiple cursors to consecutive lines |
||||
;; given an active region. |
||||
|
||||
;; Please see multiple-cursors.el for more commentary. |
||||
|
||||
;;; Code: |
||||
|
||||
(require 'multiple-cursors-core) |
||||
|
||||
(defcustom mc/edit-lines-empty-lines nil |
||||
"What should be done by `mc/edit-lines' when a line is not long enough." |
||||
:type '(radio (const :tag "Pad the line with spaces." pad) |
||||
(const :tag "Ignore the line." ignore) |
||||
(const :tag "Signal an error." error) |
||||
(const :tag "Nothing. Cursor is at end of line." nil)) |
||||
:group 'multiple-cursors) |
||||
|
||||
;;;###autoload |
||||
(defun mc/edit-lines (&optional arg) |
||||
"Add one cursor to each line of the active region. |
||||
Starts from mark and moves in straight down or up towards the |
||||
line point is on. |
||||
|
||||
What is done with lines which are not long enough is governed by |
||||
`mc/edit-lines-empty-lines'. The prefix argument ARG can be used |
||||
to override this. If ARG is a symbol (when called from Lisp), |
||||
that symbol is used instead of `mc/edit-lines-empty-lines'. |
||||
Otherwise, if ARG negative, short lines will be ignored. Any |
||||
other non-nil value will cause short lines to be padded." |
||||
(interactive "P") |
||||
(when (not (and mark-active (/= (point) (mark)))) |
||||
(error "Mark a set of lines first")) |
||||
(mc/remove-fake-cursors) |
||||
(let* ((col (current-column)) |
||||
(point-line (mc/line-number-at-pos)) |
||||
(mark-line (progn (exchange-point-and-mark) (mc/line-number-at-pos))) |
||||
(direction (if (< point-line mark-line) :up :down)) |
||||
(style (cond |
||||
;; called from lisp |
||||
((and arg (symbolp arg)) |
||||
arg) |
||||
;; negative argument |
||||
((< (prefix-numeric-value arg) 0) |
||||
'ignore) |
||||
(arg 'pad) |
||||
(t mc/edit-lines-empty-lines)))) |
||||
(deactivate-mark) |
||||
(when (and (eq direction :up) (bolp)) |
||||
(previous-logical-line 1 nil) |
||||
(move-to-column col)) |
||||
;; Add the cursors |
||||
(while (not (eq (mc/line-number-at-pos) point-line)) |
||||
;; Pad the line |
||||
(when (eq style 'pad) |
||||
(while (< (current-column) col) |
||||
(insert " "))) |
||||
;; Error |
||||
(when (and (eq style 'error) |
||||
(not (equal col (current-column)))) |
||||
(error "Short line encountered in `mc/edit-lines'")) |
||||
;; create the cursor |
||||
(unless (and (eq style 'ignore) |
||||
(not (equal col (current-column)))) |
||||
(mc/create-fake-cursor-at-point)) |
||||
;; proceed to next |
||||
(if (eq direction :up) |
||||
(previous-logical-line 1 nil) |
||||
(next-logical-line 1 nil)) |
||||
(move-to-column col)) |
||||
(multiple-cursors-mode))) |
||||
|
||||
;;;###autoload |
||||
(defun mc/edit-ends-of-lines () |
||||
"Add one cursor to the end of each line in the active region." |
||||
(interactive) |
||||
(mc/edit-lines) |
||||
(mc/execute-command-for-all-cursors 'end-of-line)) |
||||
|
||||
;;;###autoload |
||||
(defun mc/edit-beginnings-of-lines () |
||||
"Add one cursor to the beginning of each line in the active region." |
||||
(interactive) |
||||
(mc/edit-lines) |
||||
(mc/execute-command-for-all-cursors 'beginning-of-line)) |
||||
|
||||
(provide 'mc-edit-lines) |
||||
|
||||
;;; mc-edit-lines.el ends here |
||||
@ -0,0 +1,107 @@
|
||||
;;; mc-hide-unmatched-lines.el |
||||
|
||||
;; Copyright (C) 2014 Aleksey Fedotov |
||||
|
||||
;; Author: Aleksey Fedotov <lexa@cfotr.com> |
||||
;; Keywords: editing cursors |
||||
|
||||
;; 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: |
||||
|
||||
;; This minor mode when enabled hides all lines where no cursors (and |
||||
;; also hum/lines-to-expand below and above) To make use of this mode |
||||
;; press "C-'" while multiple-cursor-mode is active. You can still |
||||
;; edit lines while you are in mc-hide-unmatched-lines mode. To leave |
||||
;; this mode press "<return>" or "C-g" |
||||
;; |
||||
|
||||
;;; Code: |
||||
|
||||
(require 'multiple-cursors-core) |
||||
(require 'mc-mark-more) |
||||
|
||||
(defvar hum/hide-unmatched-lines-mode-map (make-sparse-keymap) |
||||
"Keymap for hide unmatched lines is mainly for rebinding C-g") |
||||
|
||||
(define-key hum/hide-unmatched-lines-mode-map (kbd "C-g") 'hum/keyboard-quit) |
||||
(define-key hum/hide-unmatched-lines-mode-map (kbd "<return>") 'hum/keyboard-quit) |
||||
|
||||
(defun hum/keyboard-quit () |
||||
"Leave hide-unmatched-lines mode" |
||||
(interactive) |
||||
(mc-hide-unmatched-lines-mode 0)) |
||||
|
||||
;; used only in in multiple-cursors-mode-disabled-hook |
||||
(defun hum/disable-hum-mode () |
||||
(mc-hide-unmatched-lines-mode 0)) |
||||
|
||||
;;;###autoload |
||||
(define-minor-mode mc-hide-unmatched-lines-mode |
||||
"Minor mode when enabled hides all lines where no cursors (and |
||||
also hum/lines-to-expand below and above) To make use of this |
||||
mode press \"C-'\" while multiple-cursor-mode is active. You can |
||||
still edit lines while you are in mc-hide-unmatched-lines |
||||
mode. To leave this mode press <return> or \"C-g\"" |
||||
nil " hu" |
||||
hum/hide-unmatched-lines-mode-map |
||||
(if mc-hide-unmatched-lines-mode |
||||
;;just in case if mc mode will be disabled while hide-unmatched-lines is active |
||||
(progn |
||||
(hum/hide-unmatched-lines) |
||||
(add-hook 'multiple-cursors-mode-disabled-hook 'hum/disable-hum-mode t t)) |
||||
(progn |
||||
(hum/unhide-unmatched-lines) |
||||
(remove-hook 'multiple-cursors-mode-disabled-hook 'hum/disable-hum-mode)))) |
||||
|
||||
(defconst hum/invisible-overlay-name 'hum/invisible-overlay-name) |
||||
|
||||
(defcustom hum/lines-to-expand 2 |
||||
"How many lines below and above cursor to show" |
||||
:type '(integer) |
||||
:group 'multiple-cursors) |
||||
|
||||
(defcustom hum/placeholder "..." |
||||
"Placeholder which will be placed instead of hidden text" |
||||
:type '(string) |
||||
:group 'multiple-cursors) |
||||
|
||||
(defun hum/add-invisible-overlay (begin end) |
||||
(let ((overlay (make-overlay begin |
||||
end |
||||
(current-buffer) |
||||
t |
||||
nil |
||||
))) |
||||
(overlay-put overlay hum/invisible-overlay-name t) |
||||
(overlay-put overlay 'invisible t) |
||||
(overlay-put overlay 'intangible t) |
||||
(overlay-put overlay 'evaporate t) |
||||
(overlay-put overlay 'after-string hum/placeholder))) |
||||
|
||||
(defun hum/hide-unmatched-lines () |
||||
(let ((begin (point-min))) |
||||
(mc/for-each-cursor-ordered |
||||
(save-excursion |
||||
(goto-char (mc/cursor-beg cursor)) |
||||
(if (< begin (line-beginning-position (- hum/lines-to-expand))) |
||||
(hum/add-invisible-overlay begin (line-end-position (- hum/lines-to-expand)))) |
||||
(setq begin (line-beginning-position (+ 2 hum/lines-to-expand))))) |
||||
(hum/add-invisible-overlay begin (point-max)))) |
||||
|
||||
(defun hum/unhide-unmatched-lines () |
||||
(remove-overlays nil nil hum/invisible-overlay-name t)) |
||||
|
||||
(provide 'mc-hide-unmatched-lines-mode) |
||||
(define-key mc/keymap (kbd "C-'") 'mc-hide-unmatched-lines-mode) |
||||
@ -0,0 +1,709 @@
|
||||
;;; mc-mark-more.el |
||||
|
||||
;; Copyright (C) 2012-2016 Magnar Sveen |
||||
|
||||
;; Author: Magnar Sveen <magnars@gmail.com> |
||||
;; Keywords: editing cursors |
||||
|
||||
;; 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: |
||||
|
||||
;; This file contains functions to mark more parts of the buffer. |
||||
;; See ./features/mark-more.feature for examples. |
||||
|
||||
;; Please see multiple-cursors.el for more commentary. |
||||
|
||||
;;; Code: |
||||
|
||||
(require 'multiple-cursors-core) |
||||
(require 'thingatpt) |
||||
|
||||
(defun mc/cursor-end (cursor) |
||||
(if (overlay-get cursor 'mark-active) |
||||
(max (overlay-get cursor 'point) |
||||
(overlay-get cursor 'mark)) |
||||
(overlay-get cursor 'point))) |
||||
|
||||
(defun mc/cursor-beg (cursor) |
||||
(if (overlay-get cursor 'mark-active) |
||||
(min (overlay-get cursor 'point) |
||||
(overlay-get cursor 'mark)) |
||||
(overlay-get cursor 'point))) |
||||
|
||||
(defun mc/furthest-region-end () |
||||
(let ((end (max (mark) (point)))) |
||||
(mc/for-each-fake-cursor |
||||
(setq end (max end (mc/cursor-end cursor)))) |
||||
end)) |
||||
|
||||
(defun mc/first-region-start () |
||||
(let ((beg (min (mark) (point)))) |
||||
(mc/for-each-fake-cursor |
||||
(setq beg (min beg (mc/cursor-beg cursor)))) |
||||
beg)) |
||||
|
||||
(defun mc/furthest-cursor-before-point () |
||||
(let ((beg (if mark-active (min (mark) (point)) (point))) |
||||
furthest) |
||||
(mc/for-each-fake-cursor |
||||
(when (< (mc/cursor-beg cursor) beg) |
||||
(setq beg (mc/cursor-beg cursor)) |
||||
(setq furthest cursor))) |
||||
furthest)) |
||||
|
||||
(defun mc/furthest-cursor-after-point () |
||||
(let ((end (if mark-active (max (mark) (point)) (point))) |
||||
furthest) |
||||
(mc/for-each-fake-cursor |
||||
(when (> (mc/cursor-end cursor) end) |
||||
(setq end (mc/cursor-end cursor)) |
||||
(setq furthest cursor))) |
||||
furthest)) |
||||
|
||||
(defun mc/fake-cursor-at-point (&optional point) |
||||
"Return the fake cursor with its point right at POINT (defaults |
||||
to (point)), or nil." |
||||
(setq point (or point (point))) |
||||
(let ((cursors (mc/all-fake-cursors)) |
||||
(c nil)) |
||||
(catch 'found |
||||
(while (setq c (pop cursors)) |
||||
(when (eq (marker-position (overlay-get c 'point)) |
||||
point) |
||||
(throw 'found c)))))) |
||||
|
||||
(defun mc/region-strings () |
||||
(let ((strings (list (buffer-substring-no-properties (point) (mark))))) |
||||
(mc/for-each-fake-cursor |
||||
(add-to-list 'strings (buffer-substring-no-properties |
||||
(mc/cursor-beg cursor) |
||||
(mc/cursor-end cursor)))) |
||||
strings)) |
||||
|
||||
(defvar mc/enclose-search-term nil |
||||
"How should mc/mark-more-* search for more matches? |
||||
|
||||
Match everything: nil |
||||
Match only whole words: 'words |
||||
Match only whole symbols: 'symbols |
||||
|
||||
Use like case-fold-search, don't recommend setting it globally.") |
||||
|
||||
(defun mc/mark-more-like-this (skip-last direction) |
||||
(let ((case-fold-search nil) |
||||
(re (regexp-opt (mc/region-strings) mc/enclose-search-term)) |
||||
(point-out-of-order (cl-ecase direction |
||||
(forwards (< (point) (mark))) |
||||
(backwards (not (< (point) (mark)))))) |
||||
(furthest-cursor (cl-ecase direction |
||||
(forwards (mc/furthest-cursor-after-point)) |
||||
(backwards (mc/furthest-cursor-before-point)))) |
||||
(start-char (cl-ecase direction |
||||
(forwards (mc/furthest-region-end)) |
||||
(backwards (mc/first-region-start)))) |
||||
(search-function (cl-ecase direction |
||||
(forwards 'search-forward-regexp) |
||||
(backwards 'search-backward-regexp))) |
||||
(match-point-getter (cl-ecase direction |
||||
(forwards 'match-beginning) |
||||
(backwards 'match-end)))) |
||||
(if (and skip-last (not furthest-cursor)) |
||||
(error "No cursors to be skipped") |
||||
(mc/save-excursion |
||||
(goto-char start-char) |
||||
(when skip-last |
||||
(mc/remove-fake-cursor furthest-cursor)) |
||||
(if (funcall search-function re nil t) |
||||
(progn |
||||
(push-mark (funcall match-point-getter 0)) |
||||
(when point-out-of-order |
||||
(exchange-point-and-mark)) |
||||
(mc/create-fake-cursor-at-point)) |
||||
(user-error "no more matches found.")))))) |
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-next-like-this (arg) |
||||
"Find and mark the next part of the buffer matching the currently active region |
||||
If no region is active add a cursor on the next line |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark next." |
||||
(interactive "p") |
||||
(if (< arg 0) |
||||
(let ((cursor (mc/furthest-cursor-after-point))) |
||||
(if cursor |
||||
(mc/remove-fake-cursor cursor) |
||||
(error "No cursors to be unmarked"))) |
||||
(if (region-active-p) |
||||
(mc/mark-more-like-this (= arg 0) 'forwards) |
||||
(mc/mark-lines arg 'forwards))) |
||||
(mc/maybe-multiple-cursors-mode)) |
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-next-like-this-word (arg) |
||||
"Find and mark the next part of the buffer matching the currently active region |
||||
If no region is active, mark the word at the point and find the next match |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark next." |
||||
(interactive "p") |
||||
(if (< arg 0) |
||||
(let ((cursor (mc/furthest-cursor-after-point))) |
||||
(if cursor |
||||
(mc/remove-fake-cursor cursor) |
||||
(error "No cursors to be unmarked"))) |
||||
(if (region-active-p) |
||||
(mc/mark-more-like-this (= arg 0) 'forwards) |
||||
(mc--select-thing-at-point 'word) |
||||
(mc/mark-more-like-this (= arg 0) 'forwards))) |
||||
(mc/maybe-multiple-cursors-mode)) |
||||
|
||||
(defun mc/mark-next-like-this-symbol (arg) |
||||
"Find and mark the next part of the buffer matching the currently active region |
||||
If no region is active, mark the symbol at the point and find the next match |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark next." |
||||
(interactive "p") |
||||
(if (< arg 0) |
||||
(let ((cursor (mc/furthest-cursor-after-point))) |
||||
(if cursor |
||||
(mc/remove-fake-cursor cursor) |
||||
(error "No cursors to be unmarked"))) |
||||
(if (region-active-p) |
||||
(mc/mark-more-like-this (= arg 0) 'forwards) |
||||
(mc--select-thing-at-point 'symbol) |
||||
(mc/mark-more-like-this (= arg 0) 'forwards))) |
||||
(mc/maybe-multiple-cursors-mode)) |
||||
|
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-next-word-like-this (arg) |
||||
"Find and mark the next word of the buffer matching the currently active region |
||||
The matching region must be a whole word to be a match |
||||
If no region is active, mark the symbol at the point and find the next match |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark next." |
||||
(interactive "p") |
||||
(let ((mc/enclose-search-term 'words)) |
||||
(mc/mark-next-like-this arg))) |
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-next-symbol-like-this (arg) |
||||
"Find and mark the next symbol of the buffer matching the currently active region |
||||
The matching region must be a whole symbol to be a match |
||||
If no region is active, mark the symbol at the point and find the next match |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark next." |
||||
(interactive "p") |
||||
(let ((mc/enclose-search-term 'symbols)) |
||||
(mc/mark-next-like-this arg))) |
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-previous-like-this (arg) |
||||
"Find and mark the previous part of the buffer matching the currently active region |
||||
If no region is active add a cursor on the previous line |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark next." |
||||
(interactive "p") |
||||
(if (< arg 0) |
||||
(let ((cursor (mc/furthest-cursor-before-point))) |
||||
(if cursor |
||||
(mc/remove-fake-cursor cursor) |
||||
(error "No cursors to be unmarked"))) |
||||
(if (region-active-p) |
||||
(mc/mark-more-like-this (= arg 0) 'backwards) |
||||
(mc/mark-lines arg 'backwards))) |
||||
(mc/maybe-multiple-cursors-mode)) |
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-previous-like-this-word (arg) |
||||
"Find and mark the previous part of the buffer matching the currently active region |
||||
If no region is active, mark the word at the point and find the previous match |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark previous." |
||||
(interactive "p") |
||||
(if (< arg 0) |
||||
(let ((cursor (mc/furthest-cursor-after-point))) |
||||
(if cursor |
||||
(mc/remove-fake-cursor cursor) |
||||
(error "No cursors to be unmarked"))) |
||||
(if (region-active-p) |
||||
(mc/mark-more-like-this (= arg 0) 'backwards) |
||||
(mc--select-thing-at-point 'word) |
||||
(mc/mark-more-like-this (= arg 0) 'backwards))) |
||||
(mc/maybe-multiple-cursors-mode)) |
||||
|
||||
(defun mc/mark-previous-like-this-symbol (arg) |
||||
"Find and mark the previous part of the buffer matching the currently active region |
||||
If no region is active, mark the symbol at the point and find the previous match |
||||
With negative ARG, delete the last one instead. |
||||
With zero ARG, skip the last one and mark previous." |
||||
(interactive "p") |
||||
(if (< arg 0) |
||||
(let ((cursor (mc/furthest-cursor-after-point))) |
||||
(if cursor |
||||
(mc/remove-fake-cursor cursor) |
||||
(error "No cursors to be unmarked"))) |
||||
(if (region-active-p) |
||||
(mc/mark-more-like-this (= arg 0) 'backwards) |
||||
(mc--select-thing-at-point 'symbol) |
||||
(mc/mark-more-like-this (= arg 0) 'backwards))) |
||||
(mc/maybe-multiple-cursors-mode)) |
||||
|
||||
|
||||
;;;###autoload |
||||
(defun mc/mark-previous-word-like-this (arg) |
||||