paldepind / composable.el / 156

Committed 3 Jun 2021 - 17:08 coverage decreased (-5.5%) to 86.286%

Build # 156

Build Type

Pull #37

travis-ci

Committed by

web-flow

Commit Message

Merge 37677f6bb into 6f2efaa70

Pull Request Pull Request #37: Fix and improve

Run Details

64 of 85 new or added lines in 2 files covered. (75.29%)

2 existing lines in 1 file now uncovered.

151 of 175 relevant lines covered (86.29%)

94.56 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

82.98

/composable.el

;;; composable.el --- composable editing -*- lexical-binding: t; -*-

;; Copyright (C) 2016-2020 Simon Friis Vindum

;; Author: Simon Friis Vindum <simon@vindum.io>
;; Keywords: lisp
;; Version: 0.0.1
;; Package-Requires: ((emacs "25.1"))

;; 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:

;; Composable editing for Emacs

;; composable.el is composable text editing for Emacs.  It improves the
;; basic editing power of Emacs by making commands combineable.

;; It's inspired by vim but implemented in a way that reuses existing
;; Emacs infrastructure.  This makes it simple and compatible with
;; existing Emacs functionality and concepts.  composable.el only brings
;; together existing features in a slightly different way.

;; Composable editing is a simple abstraction that makes it possible to
;; combine _actions_ with _objects_.  The key insight in composable.el is
;; that Emacs already provides all the primitives to implement composable
;; editing.  An action is an Emacs command that operates on the region.
;; Thus `kill-region` and `comment-region` are actions.  An object is
;; specified by a command that moves point and optionally sets the mark
;; as well.  Examples are `move-end-of-line` and `mark-paragraph`.

;; So actions and objects are just names for things already present in
;; Emacs.  The primary feature that composable.el introduces is a
;; _composable command_.  A composable command has an associated action.
;; Invoking it works like this:

;; 1. If the region is active the associated action is invoked directly.
;; 2. Otherwise nothing happens, but the editor is now listening for an
;;    object.  This activates a set of bindings that makes it convenient
;;    to input objects.  For instance pressing `l` makes the action
;;    operate on the current line.
;; 3. After the object has been entered the action is invoked on the
;;    specified object.


;;; Code:

(require 'composable-mark)

;;* Customization
(defgroup composable nil
  "Composable editing."
  :prefix "composable-"
  :group 'tools)

(defcustom composable-which-keys t
  "Show bindings available when entering composable if which-key is installed."
  :type 'boolean)

(defcustom composable-repeat t
  "Repeat the last excuted action by repressing the last key."
  :type 'boolean)

(defcustom composable-repeat-copy-save-last t
  "Keep only the last copied text in the `kill-ring'."
  :type 'boolean)

(defcustom composable-object-cursor (and (display-graphic-p)
                                         #'composable-half-cursor)
  "Use a custom face for the cursor when in object mode.
This can be either a function or any value accepted by
`cursor-type'."
  :type 'function)

(defcustom composable-twice-mark #'composable-mark-line
  "Thing to mark when a composable command is called twice successively."
  :type 'function)

(defcustom composable-mode-line-color "cyan"
  "Color for mode-line background when composable is active."
  :type 'color)

(defcustom composable-mode-debug-level 1
  "Print verbose information when composable modes toggle."
  :type 'integer)

(defface composable-highlight
  '((t (:inherit secondary-selection :extend nil)))
  "Faced used to highlight the saved region.")

(defvar composable--overlay nil)
(defvar composable--saved-mode-line-color nil)
(defvar composable--command nil)
(defvar composable--count 0)                 ;; Count the repeated times
(defvar composable--prefix-arg nil)
(defvar composable--start-marker (make-marker))
(defvar composable--command-prefix nil)
(defvar composable--saved-cursor nil)
(defvar composable--expand nil)
(defvar composable--which-key-timer nil)
(defvar composable--char-input nil)

(defcustom composable-fn-pair-alist
  '((forward-word . backward-word)
    (move-end-of-line . back-to-indentation)
    (next-line . previous-line)
    (forward-paragraph . backward-paragraph)
    (forward-sentence . backward-sentence))
  "Alist with pairs of functions."
  :type '(alist :key-type symbol :value-type symbol))

(defsubst composable-mode-debug-message (format-string &rest args)
  "Print messages only when `composable-mode-debug' is `non-nil'.

The arguments FORMAT-STRING and ARGS are the same than in the
`message' function."
  (if (> composable-mode-debug-level 0)
      (let ((inhibit-message (< composable-mode-debug-level 2)))
        (apply #'message format-string args))))

(defun composable-create-composable (command)
  "Take a function and return it in a composable wrapper.
The returned function will ask for an object, mark the region it
specifies and call COMMAND on the region."
  `(defun ,(intern (concat "composable-" (symbol-name `,command))) (arg)
     ,(format "Composable wrapper for `%s'" (symbol-name command))
     (interactive "P")
     (cond ((or (region-active-p) ;; With region
                (bound-and-true-p multiple-cursors-mode))
            (setq composable--count 0)
            (call-interactively #',command))
           (composable-object-mode ;; Repeated
            (setq this-command composable-twice-mark)
            (funcall composable-twice-mark arg))
           (t                      ;; First call no region
            (setq composable--command-prefix arg
                  composable--command #',command)
            (composable-object-mode)))))

(defmacro composable-def (commands-list)
  "Define composable function from a list COMMANDS.
The list should contain functions operating on regions.
For each function named foo a function name composable-foo is created."
  `(progn ,@(mapcar #'composable-create-composable commands-list)
          (easy-mmode-defmap composable-mode-map
            '(,@(mapcar (lambda (command)
                          `([remap ,command] . ,(intern (concat "composable-" (symbol-name command)))))
                        commands-list)
              ([remap kill-line] . composable-delete-region))
            "Keymap for composable-mode commands after entering.")))

(composable-def (kill-region
                 kill-ring-save
                 indent-region
                 comment-dwim
                 upcase-region
                 downcase-region
                 delete-region))

(defun composable-half-cursor ()
  "Change cursor to a half-height box."
  (setq cursor-type
        (cons 'hbar (/ (window-pixel-height) (* (window-height) 2)))))

(defun composable--call-excursion (command)
  "Call COMMAND if set then go to POINT-MARK marker."
  (when (commandp command)
    (let ((current-prefix-arg composable--command-prefix))
      (call-interactively command)
      (if (= composable--count 1)
          (push-mark (point) t)
        (set-mark (point)))
      (goto-char composable--start-marker))))

(defun composable--repeater (command object direction)
  "Preserve point at POINT-MARKER when doing COMMAND.
Executes on OBJECT in LAST-PREFIX direction."
  (lambda ()
    (interactive)
    (unless composable--expand
      (goto-char (mark t)))
    (activate-mark)
    (setq composable--count (1+ composable--count))
    (let ((current-prefix-arg direction))
      (call-interactively object))
    (composable--call-excursion command)))

(defconst composable--arguments
  '(universal-argument
    digit-argument
    negative-argument
    composable-begin-argument
    composable-end-argument))

(defun composable--object-exit ()
  "Actions to perform every time composable exits."

  (composable-mode-debug-message "Exit composable-object-mode")
  (set-marker composable--start-marker nil)

  (when composable--saved-cursor
   (setq cursor-type composable--saved-cursor))
  (when composable--saved-mode-line-color
    (set-face-attribute 'mode-line nil :background composable--saved-mode-line-color))
  (when composable--overlay
    (delete-overlay composable--overlay))

  (advice-remove 'keyboard-quit #'composable-object-mode-disable)
  (setq composable--expand nil))  ;; By default the commands don't expand

(defun composable--singleton-map (key def)
  "Create a map with a single KEY with definition DEF."
  (let ((map (make-sparse-keymap)))
    (define-key map key def)
    ;; When using composable char can repeat the char to repeat the
    ;; command
    (if (characterp composable--char-input)
        (define-key map (string composable--char-input) def))
    map))

(defun composable--activate-repeat (object)
  "Activate repeat map on OBJECT preserving point at POINT-MARKER."
  (interactive)
  (set-transient-map
   (composable--singleton-map
    (vector last-command-event)
    (composable--repeater composable--command object
                          (composable--direction last-prefix-arg)))
   t
   #'composable--object-exit))

(defun composable--handle-prefix (command)
  "Handle prefix arg where the COMMAND is paired in PAIRS."
  (let ((pair (or (alist-get command composable-fn-pair-alist)
                  (car (rassq command composable-fn-pair-alist)))))
    (cond (pair
           (push-mark)
           (call-interactively pair))
          (mark-active
           (if (eq composable--prefix-arg 'composable-begin)
               (progn
                 (set-mark (min (mark t) composable--start-marker))
                 (goto-char (min (point) composable--start-marker)))
             (set-mark (max (mark t) composable--start-marker))
             (goto-char (max (point) composable--start-marker)))))))

(defun composable--post-command-hook-handler ()
  "Called after each command when composable-object-mode is on."
  (cond
   ((= composable--count 0)
    (setq composable--count 1))
   ((and (not (member this-command composable--arguments)) ;; detect prefix < 25.1
         (not (eq last-command this-command))) ;; in 25.1 prefix args don't change `this-command'
    (when composable--prefix-arg
      (composable--handle-prefix this-command))
    (when composable-repeat
      (composable--activate-repeat this-command))
    (composable--call-excursion composable--command)
    (composable-object-mode -1))))

(defun composable-begin-argument ()
  "Set prefix argument to end."
  (interactive)
  (setq composable--prefix-arg 'composable-begin))

(defun composable-end-argument ()
  "Set prefix argument to end."
  (interactive)
  (setq composable--prefix-arg 'composable-end))

(defun composable-goto-char (arg)
  "Goto-char command for composable."
  (interactive "p")
  (unless composable--char-input
    (setq composable--char-input (read-char "char: " t)))
  (search-forward (char-to-string composable--char-input) nil nil arg))

(defun copy-region-as-kill-advise (beg end &optional _)
  "Extra advise for copy-region-as-kill to enable the overlay.

This also prevents messing the clipboard."
  (interactive (list (mark) (point)))
  (when (and (marker-position composable--start-marker)
             (> composable--count 0))
    (move-overlay composable--overlay
                  (min beg composable--start-marker end)
                  (max beg composable--start-marker end))

    (when (and (> composable--count 1)
               composable-repeat-copy-save-last)
      (setq last-command #'kill-region))))

(easy-mmode-defmap composable-object-mode-map
  `(,@(mapcar (lambda (num)
                (cons (format "%s" num) 'digit-argument))
              (number-sequence 0 9))
    ("-" . negative-argument)
    ("[" . composable-begin-argument)
    ("]" . composable-end-argument)
    ("a" . move-beginning-of-line)
    ("c" . composable-goto-char)
    ("e" . move-end-of-line)
    ("f" . forward-word)
    ("b" . backward-word)
    ("u" . mark-whole-buffer)
    ("n" . next-line)
    ("p" . previous-line)
    ("l" . composable-mark-line)
    ("{" . backward-paragraph)
    ("}" . forward-paragraph)
    ("s" . mark-sexp)
    ("m" . back-to-indentation)
    ("w" . composable-mark-word)
    ("." . composable-mark-symbol)
    ("h" . composable-mark-paragraph)
    ("j" . composable-mark-join)
    ("o" . composable-mark-up-list)
    ("g" . keyboard-quit))
  "Keymap for composable-object-mode commands after entering.")

(define-minor-mode composable-object-mode
  "Composable mode."
  :lighter (if (> composable-mode-debug-level 1)
               " Composable object" "")
  :keymap composable-object-mode-map
  (if composable-object-mode
      (progn
        (when (and composable-mode-line-color  ;; Mode-line
                   (color-supported-p composable-mode-line-color))
          (setq composable--saved-mode-line-color (face-attribute 'mode-line :background))
          (set-face-attribute 'mode-line nil :background composable-mode-line-color))

        (when composable-object-cursor       ;; "Change cursor cursor to C"
          (setq composable--saved-cursor cursor-type
                cursor-type (or (and (functionp composable-object-cursor)
                                     (funcall composable-object-cursor))
                                composable-object-cursor)))

        (setq composable--start-marker (point-marker)
              composable--count 0
              composable--char-input nil)

        (push-mark nil t)

        ;; which-key
        (when (and composable-which-keys
                   (bound-and-true-p which-key-mode))
          (setq composable--which-key-timer
                (run-with-idle-timer which-key-idle-delay nil
                                     #'which-key-show-keymap 'composable-object-mode-map t)))

        (add-hook 'post-command-hook #'composable--post-command-hook-handler)
        (advice-add 'keyboard-quit :before #'composable-object-mode-disable)
        (composable-mode-debug-message "Start composable-object-mode (command: %s)" this-command))

    ;; else
    (remove-hook 'post-command-hook #'composable--post-command-hook-handler)
    (setq composable--prefix-arg nil
          composable--command nil)

    (when (bound-and-true-p which-key-mode)
      (cancel-timer composable--which-key-timer))

    (when (or (called-interactively-p 'any)
              (not composable-repeat))
      (composable--object-exit)
      (deactivate-mark))))

(defun composable-object-mode-disable ()
  (interactive)
  (when composable-object-mode ;; This check is extremely important
    (funcall-interactively #'composable-object-mode -1)))

;;;###autoload
(define-minor-mode composable-mode
  "Toggle Composable mode."
  :lighter " Composable mode"
  :global 1
  :keymap composable-mode-map
  (if composable-mode
      (progn
        (setq composable--overlay (make-overlay 0 0))

        (overlay-put composable--overlay 'priority 999)
        (overlay-put composable--overlay 'face 'composable-highlight)
        ;; associate the overlay with no specific buffer. Otherwise it
        ;; may be not visible when set for the first time and appear
        ;; visible when not expected.
        (delete-overlay composable--overlay)
        (advice-add 'copy-region-as-kill :before #'copy-region-as-kill-advise))
    (setq composable--overlay nil)
    (advice-remove 'copy-region-as-kill #'copy-region-as-kill-advise)))

(defun composable--deactivate-mark-hook-handler ()
  "Leave object mode when the mark is disabled."
  (composable-object-mode-disable))

(defun composable--set-mark-command-advice (arg)
  "Advice for `set-mark-command'.
Activates composable-object-mode unless ARG is non-nil."
  (unless (or composable-object-mode
              arg
              (bound-and-true-p multiple-cursors-mode))
    (setq composable--expand t)
    (composable-object-mode 1)))

;;;###autoload
(define-minor-mode composable-mark-mode
  "Toggle composable mark mode."
  :global 1
  (if composable-mark-mode
      (progn
        (add-hook 'deactivate-mark-hook #'composable--deactivate-mark-hook-handler)
        (advice-add 'set-mark-command :before #'composable--set-mark-command-advice))
    (remove-hook 'deactivate-mark-hook #'composable--deactivate-mark-hook-handler)
    (advice-remove 'set-mark-command #'composable--set-mark-command-advice)))

(provide 'composable)

;;; composable.el ends here

1	;;; composable.el --- composable editing -- lexical-binding: t; --
2
3	;; Copyright (C) 2016-2020 Simon Friis Vindum
4
5	;; Author: Simon Friis Vindum <simon@vindum.io>
6	;; Keywords: lisp
7	;; Version: 0.0.1
8	;; Package-Requires: ((emacs "25.1"))
9
10	;; This program is free software; you can redistribute it and/or modify
11	;; it under the terms of the GNU General Public License as published by
12	;; the Free Software Foundation, either version 3 of the License, or
13	;; (at your option) any later version.
14
15	;; This program is distributed in the hope that it will be useful,
16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18	;; GNU General Public License for more details.
19
20	;; You should have received a copy of the GNU General Public License
21	;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22
23	;;; Commentary:
24
25	;; Composable editing for Emacs
26
27	;; composable.el is composable text editing for Emacs. It improves the
28	;; basic editing power of Emacs by making commands combineable.
29
30	;; It's inspired by vim but implemented in a way that reuses existing
31	;; Emacs infrastructure. This makes it simple and compatible with
32	;; existing Emacs functionality and concepts. composable.el only brings
33	;; together existing features in a slightly different way.
34
35	;; Composable editing is a simple abstraction that makes it possible to
36	;; combine _actions_ with _objects_. The key insight in composable.el is
37	;; that Emacs already provides all the primitives to implement composable
38	;; editing. An action is an Emacs command that operates on the region.
39	;; Thus `kill-region` and `comment-region` are actions. An object is
40	;; specified by a command that moves point and optionally sets the mark
41	;; as well. Examples are `move-end-of-line` and `mark-paragraph`.
42
43	;; So actions and objects are just names for things already present in
44	;; Emacs. The primary feature that composable.el introduces is a
45	;; _composable command_. A composable command has an associated action.
46	;; Invoking it works like this:
47
48	;; 1. If the region is active the associated action is invoked directly.
49	;; 2. Otherwise nothing happens, but the editor is now listening for an
50	;; object. This activates a set of bindings that makes it convenient
51	;; to input objects. For instance pressing `l` makes the action
52	;; operate on the current line.
53	;; 3. After the object has been entered the action is invoked on the
54	;; specified object.
55
56
57	;;; Code:
58
59	(require 'composable-mark)
60
61	;;* Customization
62	(defgroup composable nil
63	"Composable editing."
64	:prefix "composable-"
65	:group 'tools)
66
67	(defcustom composable-which-keys t
68	"Show bindings available when entering composable if which-key is installed."
69	:type 'boolean)
70
71	(defcustom composable-repeat t
72	"Repeat the last excuted action by repressing the last key."
73	:type 'boolean)
74
75	(defcustom composable-repeat-copy-save-last t
76	"Keep only the last copied text in the `kill-ring'."
77	:type 'boolean)
78
79	(defcustom composable-object-cursor (and (display-graphic-p)
80	#'composable-half-cursor)
81	"Use a custom face for the cursor when in object mode.
82	This can be either a function or any value accepted by
83	`cursor-type'."
84	:type 'function)
85
86	(defcustom composable-twice-mark #'composable-mark-line
87	"Thing to mark when a composable command is called twice successively."
88	:type 'function)
89
90	(defcustom composable-mode-line-color "cyan"
91	"Color for mode-line background when composable is active."
92	:type 'color)
93
94	(defcustom composable-mode-debug-level 1
95	"Print verbose information when composable modes toggle."
96	:type 'integer)
97
98	(defface composable-highlight
99	'((t (:inherit secondary-selection :extend nil)))
100	"Faced used to highlight the saved region.")
101
102	(defvar composable--overlay nil)
103	(defvar composable--saved-mode-line-color nil)
104	(defvar composable--command nil)
105	(defvar composable--count 0) ;; Count the repeated times
106	(defvar composable--prefix-arg nil)
107	(defvar composable--start-marker (make-marker))
108	(defvar composable--command-prefix nil)
109	(defvar composable--saved-cursor nil)
110	(defvar composable--expand nil)
111	(defvar composable--which-key-timer nil)
112	(defvar composable--char-input nil)
113
114	(defcustom composable-fn-pair-alist
115	'((forward-word . backward-word)
116	(move-end-of-line . back-to-indentation)
117	(next-line . previous-line)
118	(forward-paragraph . backward-paragraph)
119	(forward-sentence . backward-sentence))
120	"Alist with pairs of functions."
121	:type '(alist :key-type symbol :value-type symbol))
122
123	(defsubst composable-mode-debug-message (format-string &rest args)
124	"Print messages only when `composable-mode-debug' is `non-nil'.
125
126	The arguments FORMAT-STRING and ARGS are the same than in the
127	`message' function."
128	(if (> composable-mode-debug-level 0)	390×
129	(let ((inhibit-message (< composable-mode-debug-level 2)))	390×
130	(apply #'message format-string args))))	390×
131
132	(defun composable-create-composable (command)
133	"Take a function and return it in a composable wrapper.
134	The returned function will ask for an object, mark the region it
135	specifies and call COMMAND on the region."
136	`(defun ,(intern (concat "composable-" (symbol-name `,command))) (arg)	21×
137	,(format "Composable wrapper for `%s'" (symbol-name command))	21×
138	(interactive "P")
139	(cond ((or (region-active-p) ;; With region
140	(bound-and-true-p multiple-cursors-mode))
141	(setq composable--count 0)
142	(call-interactively #',command))	21×
143	(composable-object-mode ;; Repeated
144	(setq this-command composable-twice-mark)
145	(funcall composable-twice-mark arg))
146	(t ;; First call no region
147	(setq composable--command-prefix arg
148	composable--command #',command)	21×
149	(composable-object-mode)))))	21×
150
151	(defmacro composable-def (commands-list)
152	"Define composable function from a list COMMANDS.
153	The list should contain functions operating on regions.
154	For each function named foo a function name composable-foo is created."
155	`(progn ,@(mapcar #'composable-create-composable commands-list)	3×
156	(easy-mmode-defmap composable-mode-map
157	'(,@(mapcar (lambda (command)	3×
158	`([remap ,command] . ,(intern (concat "composable-" (symbol-name command)))))	21×
159	commands-list)	3×
160	([remap kill-line] . composable-delete-region))
161	"Keymap for composable-mode commands after entering.")))	3×
162
163	(composable-def (kill-region
164	kill-ring-save
165	indent-region
166	comment-dwim
167	upcase-region
168	downcase-region
169	delete-region))
170
171	(defun composable-half-cursor ()
172	"Change cursor to a half-height box."
NEW 173	(setq cursor-type	!
NEW 174	(cons 'hbar (/ (window-pixel-height) (* (window-height) 2)))))	!
175
176	(defun composable--call-excursion (command)
177	"Call COMMAND if set then go to POINT-MARK marker."
178	(when (commandp command)	276×
179	(let ((current-prefix-arg composable--command-prefix))	240×
180	(call-interactively command)	240×
181	(if (= composable--count 1)	240×
182	(push-mark (point) t)	165×
183	(set-mark (point)))	75×
184	(goto-char composable--start-marker))))	240×
185
186	(defun composable--repeater (command object direction)
187	"Preserve point at POINT-MARKER when doing COMMAND.
188	Executes on OBJECT in LAST-PREFIX direction."
189	(lambda ()
190	(interactive)
191	(unless composable--expand	84×
192	(goto-char (mark t)))	75×
193	(activate-mark)	84×
194	(setq composable--count (1+ composable--count))	84×
195	(let ((current-prefix-arg direction))	84×
196	(call-interactively object))	84×
197	(composable--call-excursion command)))	84×
198
199	(defconst composable--arguments
200	'(universal-argument
201	digit-argument
202	negative-argument
203	composable-begin-argument
204	composable-end-argument))
205
206	(defun composable--object-exit ()
207	"Actions to perform every time composable exits."
208
209	(composable-mode-debug-message "Exit composable-object-mode")	192×
210	(set-marker composable--start-marker nil)	192×
211
212	(when composable--saved-cursor	192×
213	(setq cursor-type composable--saved-cursor))	!
214	(when composable--saved-mode-line-color	192×
215	(set-face-attribute 'mode-line nil :background composable--saved-mode-line-color))	192×
216	(when composable--overlay	192×
217	(delete-overlay composable--overlay))	192×
218
219	(advice-remove 'keyboard-quit #'composable-object-mode-disable)	192×
220	(setq composable--expand nil)) ;; By default the commands don't expand	192×
221
222	(defun composable--singleton-map (key def)
223	"Create a map with a single KEY with definition DEF."
224	(let ((map (make-sparse-keymap)))	192×
225	(define-key map key def)	192×
226	;; When using composable char can repeat the char to repeat the
227	;; command
228	(if (characterp composable--char-input)	192×
229	(define-key map (string composable--char-input) def))	24×
230	map))	192×
231
232	(defun composable--activate-repeat (object)
233	"Activate repeat map on OBJECT preserving point at POINT-MARKER."
234	(interactive)
235	(set-transient-map	192×
236	(composable--singleton-map	192×
237	(vector last-command-event)	192×
238	(composable--repeater composable--command object	192×
239	(composable--direction last-prefix-arg)))	192×
240	t
241	#'composable--object-exit))	192×
242
243	(defun composable--handle-prefix (command)
244	"Handle prefix arg where the COMMAND is paired in PAIRS."
245	(let ((pair (or (alist-get command composable-fn-pair-alist)	24×
246	(car (rassq command composable-fn-pair-alist)))))	18×
247	(cond (pair	24×
248	(push-mark)	12×
249	(call-interactively pair))	12×
250	(mark-active	12×
251	(if (eq composable--prefix-arg 'composable-begin)	12×
252	(progn	6×
253	(set-mark (min (mark t) composable--start-marker))	6×
254	(goto-char (min (point) composable--start-marker)))	6×
255	(set-mark (max (mark t) composable--start-marker))	6×
256	(goto-char (max (point) composable--start-marker)))))))	6×
257
258	(defun composable--post-command-hook-handler ()
259	"Called after each command when composable-object-mode is on."
260	(cond	465×
261	((= composable--count 0)	465×
262	(setq composable--count 1))	198×
263	((and (not (member this-command composable--arguments)) ;; detect prefix < 25.1	267×
264	(not (eq last-command this-command))) ;; in 25.1 prefix args don't change `this-command'	243×
265	(when composable--prefix-arg	192×
266	(composable--handle-prefix this-command))	24×
267	(when composable-repeat	192×
268	(composable--activate-repeat this-command))	192×
269	(composable--call-excursion composable--command)	192×
270	(composable-object-mode -1))))	192×
271
272	(defun composable-begin-argument ()
273	"Set prefix argument to end."
274	(interactive)
275	(setq composable--prefix-arg 'composable-begin))	12×
276
277	(defun composable-end-argument ()
278	"Set prefix argument to end."
279	(interactive)
280	(setq composable--prefix-arg 'composable-end))	12×
281
282	(defun composable-goto-char (arg)
283	"Goto-char command for composable."
284	(interactive "p")
285	(unless composable--char-input	42×
286	(setq composable--char-input (read-char "char: " t)))	24×
287	(search-forward (char-to-string composable--char-input) nil nil arg))	42×
288
289	(defun copy-region-as-kill-advise (beg end &optional _)
290	"Extra advise for copy-region-as-kill to enable the overlay.
291
292	This also prevents messing the clipboard."
NEW 293	(interactive (list (mark) (point)))	!
NEW 294	(when (and (marker-position composable--start-marker)	!
NEW 295	(> composable--count 0))	!
NEW 296	(move-overlay composable--overlay	!
NEW 297	(min beg composable--start-marker end)	!
NEW 298	(max beg composable--start-marker end))	!
299
NEW 300	(when (and (> composable--count 1)	!
NEW 301	composable-repeat-copy-save-last)	!
NEW 302	(setq last-command #'kill-region))))	!
303
304	(easy-mmode-defmap composable-object-mode-map
305	`(,@(mapcar (lambda (num)
306	(cons (format "%s" num) 'digit-argument))
307	(number-sequence 0 9))
308	("-" . negative-argument)
309	("[" . composable-begin-argument)
310	("]" . composable-end-argument)
311	("a" . move-beginning-of-line)
312	("c" . composable-goto-char)
313	("e" . move-end-of-line)
314	("f" . forward-word)
315	("b" . backward-word)
316	("u" . mark-whole-buffer)
317	("n" . next-line)
318	("p" . previous-line)
319	("l" . composable-mark-line)
320	("{" . backward-paragraph)
321	("}" . forward-paragraph)
322	("s" . mark-sexp)
323	("m" . back-to-indentation)
324	("w" . composable-mark-word)
325	("." . composable-mark-symbol)
326	("h" . composable-mark-paragraph)
327	("j" . composable-mark-join)
328	("o" . composable-mark-up-list)
329	("g" . keyboard-quit))
330	"Keymap for composable-object-mode commands after entering.")
331
332	(define-minor-mode composable-object-mode
333	"Composable mode."
334	:lighter (if (> composable-mode-debug-level 1)
335	" Composable object" "")
336	:keymap composable-object-mode-map
337	(if composable-object-mode	396×
338	(progn	198×
339	(when (and composable-mode-line-color ;; Mode-line	198×
340	(color-supported-p composable-mode-line-color))	198×
341	(setq composable--saved-mode-line-color (face-attribute 'mode-line :background))	198×
342	(set-face-attribute 'mode-line nil :background composable-mode-line-color))	198×
343
344	(when composable-object-cursor ;; "Change cursor cursor to C"	198×
NEW 345	(setq composable--saved-cursor cursor-type	!
NEW 346	cursor-type (or (and (functionp composable-object-cursor)	!
NEW 347	(funcall composable-object-cursor))	!
NEW 348	composable-object-cursor)))	!
349
350	(setq composable--start-marker (point-marker)	198×
351	composable--count 0
352	composable--char-input nil)	198×
353
354	(push-mark nil t)	198×
355
356	;; which-key
357	(when (and composable-which-keys	198×
358	(bound-and-true-p which-key-mode))	198×
NEW 359	(setq composable--which-key-timer	!
NEW 360	(run-with-idle-timer which-key-idle-delay nil	!
NEW 361	#'which-key-show-keymap 'composable-object-mode-map t)))	!
362
363	(add-hook 'post-command-hook #'composable--post-command-hook-handler)	198×
364	(advice-add 'keyboard-quit :before #'composable-object-mode-disable)	198×
365	(composable-mode-debug-message "Start composable-object-mode (command: %s)" this-command))	198×
366
367	;; else
368	(remove-hook 'post-command-hook #'composable--post-command-hook-handler)	198×
369	(setq composable--prefix-arg nil	198×
370	composable--command nil)	198×
371
372	(when (bound-and-true-p which-key-mode)	198×
NEW 373	(cancel-timer composable--which-key-timer))	!
374
375	(when (or (called-interactively-p 'any)	198×
376	(not composable-repeat))	198×
UNCOV 377	(composable--object-exit)	!
UNCOV 378	(deactivate-mark))))	!
379
380	(defun composable-object-mode-disable ()
381	(interactive)
382	(when composable-object-mode ;; This check is extremely important	213×
383	(funcall-interactively #'composable-object-mode -1)))	6×
384
385	;;;###autoload
386	(define-minor-mode composable-mode
387	"Toggle Composable mode."
388	:lighter " Composable mode"
389	:global 1
390	:keymap composable-mode-map
391	(if composable-mode	3×
392	(progn	3×
393	(setq composable--overlay (make-overlay 0 0))	3×
394
395	(overlay-put composable--overlay 'priority 999)	3×
396	(overlay-put composable--overlay 'face 'composable-highlight)	3×
397	;; associate the overlay with no specific buffer. Otherwise it
398	;; may be not visible when set for the first time and appear
399	;; visible when not expected.
400	(delete-overlay composable--overlay)	3×
401	(advice-add 'copy-region-as-kill :before #'copy-region-as-kill-advise))	3×
NEW 402	(setq composable--overlay nil)	!
NEW 403	(advice-remove 'copy-region-as-kill #'copy-region-as-kill-advise)))	!
404
405	(defun composable--deactivate-mark-hook-handler ()
406	"Leave object mode when the mark is disabled."
407	(composable-object-mode-disable))	210×
408
409	(defun composable--set-mark-command-advice (arg)
410	"Advice for `set-mark-command'.
411	Activates composable-object-mode unless ARG is non-nil."
412	(unless (or composable-object-mode	36×
413	arg	33×
414	(bound-and-true-p multiple-cursors-mode))	30×
415	(setq composable--expand t)	30×
416	(composable-object-mode 1)))	30×
417
418	;;;###autoload
419	(define-minor-mode composable-mark-mode
420	"Toggle composable mark mode."
421	:global 1
422	(if composable-mark-mode	213×
423	(progn	210×
424	(add-hook 'deactivate-mark-hook #'composable--deactivate-mark-hook-handler)	210×
425	(advice-add 'set-mark-command :before #'composable--set-mark-command-advice))	210×
426	(remove-hook 'deactivate-mark-hook #'composable--deactivate-mark-hook-handler)	3×
427	(advice-remove 'set-mark-command #'composable--set-mark-command-advice)))	3×
428
429	(provide 'composable)
430
431	;;; composable.el ends here

paldepind / composable.el / 156

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous