branch: elpa/meow
commit bc05b048d3582425717d114b837b8fe78d47a753
Author: 45mg <[email protected]>
Commit: GitHub <[email protected]>

    Allow custom 'word', 'symbol' definitions (#596)
    
    * Allow custom 'word', 'symbol' definitions
    
    Allows users to customize the behavior of the commands related to
    marking and moving by words and symbols.
    
    Make all commands related to words and symbols rely on `forward-thing'
    and `bounds-of-thing-at-point'. Then, define the 'thing's that these
    functions are called on in `meow-word-thing' and `meow-symbol-thing'.
    Now the user can define their own things and make Meow use them by
    setting these variables.
    
    Meow users may find Emacs' default notions of 'word' and 'symbol' to be
    unsatisfactory for modal editing. For example, word movements tend to
    skip over non-alphanumeric characters, meaning that `meow-next-word' and
    `meow-back-word' will skip them when not expanding a selection. This
    commit allows users to redefine these notions via `thingatpt'.
    
    With this change, every Meow motion is now customizable. The only
    exception is `meow-line'; it should not be necessary to change its
    behavior since Meow already provides `meow-visual-line'.
    
    * Consolidate, thingatpt-ify 'word', 'symbol' logic
    
    In addition to all commands related to words and symbols now relying
    `forward-thing' and `bounds-of-thing-at-point', which use the things
    defined in `meow-word-thing' and `meow-symbol-thing', this commit
    consolidates the logic used by these commands into `meow-mark-thing',
    `meow-next-thing', `meow--fix-thing-selection-mark',
    `meow--forward-thing-1', and `meow--backward-thing-1'. This results in
    much less code duplication.
---
 CUSTOMIZATIONS.org |  52 ++++++++++++++++
 meow-beacon.el     |   8 ++-
 meow-command.el    | 174 +++++++++++++++++++++++------------------------------
 meow-thing.el      |   6 +-
 meow-var.el        |  28 +++++++++
 5 files changed, 165 insertions(+), 103 deletions(-)

diff --git a/CUSTOMIZATIONS.org b/CUSTOMIZATIONS.org
index 8416d4d6a3..3c5918e48b 100644
--- a/CUSTOMIZATIONS.org
+++ b/CUSTOMIZATIONS.org
@@ -358,3 +358,55 @@ change the variable =meow-cursor-type-insert=.
 
 Association list of symbols to their corresponding keymaps. Used
 to generate =meow-*-define-key= helpers.
+
+** meow-word-thing, meow-symbol-thing
+
+The things used by meow for marking/movement by words and symbols, 
respectively.
+
+The values are 'things' as understood by ~thingatpt~ - symbols that will be
+passed to ~forward-thing~ and ~bounds-of-thing-at-point~, which see.
+
+This means that they must, at minimum, have a function as the value of their
+=forward-op= symbol property (or the function should be defined as
+~forward-SYMBOLNAME~). This function should accept a single argument, a number
+=n=, and should move over the next =n= things, in either the forward or 
backward
+direction depending on the sign of =n=. Examples of such functions include
+~forward-word~, ~forward-symbol~ and ~forward-sexp~, which ~thingatpt~ uses for
+the =word=, =symbol= and =sexp= things, respectively.
+
+*** Custom =word=, =symbol= definitions
+
+By customizing these variables, you can make Meow use your own definitions for
+=word= and =symbol=. For example, here is how you can get =word= behavior 
closer
+to Vim's -
+
+#+begin_src emacs-lisp
+(defun forward-vimlike-word (&optional arg)
+  "Alternate `forward-word'. Essentially the same idea as Vim's 'e'."
+  (interactive "^p")
+  (setq arg (or arg 1))
+  (cl-destructuring-bind (sign move-func char-func)
+      (if (>= arg 0)
+          '(1 skip-syntax-forward char-after)
+        '(-1 skip-syntax-backward char-before))
+    (with-syntax-table (standard-syntax-table)
+      (let ((distance sign))
+        (while (and distance (> (abs distance) 0) (> (* arg sign) 0))
+          (setq distance
+                (when-let ((next-char (funcall char-func))
+                           (next-syntax (char-syntax next-char)))
+                  (cond ((eq next-syntax ?w)
+                         (funcall move-func "w"))
+                        ((eq next-syntax ?\ )
+                         (prog1
+                             (funcall move-func " ")
+                           (forward-vimlike-word sign)))
+                        (t
+                         (funcall move-func "^w ")))))
+          (setq arg (- arg sign)))
+        (and distance (> (abs distance) 0))))))
+
+(put 'vimlike-word 'forward-op #'forward-vimlike-word)
+
+(setq meow-word-thing 'vimlike-word)
+#+end_src
diff --git a/meow-beacon.el b/meow-beacon.el
index 718904966d..5f20354cd1 100644
--- a/meow-beacon.el
+++ b/meow-beacon.el
@@ -216,13 +216,17 @@ same way, and escape each time the macro is applied."
           (progn
             (save-mark-and-excursion
               (goto-char (point-min))
-              (while (forward-word 1)
+              (while (let ((p (point)))
+                       (forward-thing meow-word-thing 1)
+                       (not (= p (point))))
                 (unless (= (point) orig)
                   (meow--beacon-add-overlay-at-point (meow--hack-cursor-pos 
(point)))))))
 
         (save-mark-and-excursion
           (goto-char (point-max))
-          (while (forward-word -1)
+          (while (let ((p (point)))
+                       (forward-thing meow-word-thing -1)
+                       (not (= p (point))))
             (unless (= (point) orig)
               (meow--beacon-add-overlay-at-point (point))))))))
   (meow--beacon-shrink-selection))
diff --git a/meow-command.el b/meow-command.el
index e400a10164..32ff5bed65 100644
--- a/meow-command.el
+++ b/meow-command.el
@@ -730,6 +730,34 @@ See `meow-next-line' for how prefix arguments work."
     (setq this-command #'next-line)
     (meow--execute-kbd-macro meow--kbd-forward-line))))
 
+(defun meow-mark-thing (thing type &optional backward regexp-format)
+  "Make expandable selection of THING, with TYPE and forward/BACKWARD 
direction.
+
+THING is a symbol usable by `forward-thing', which see.
+
+TYPE is a symbol. Usual values are `word' or `line'.
+
+The selection will be made in the \\='forward\\=' direction unless BACKWARD is
+non-nil.
+
+When REGEXP-FORMAT is non-nil and a string, the content of the selection will 
be
+quoted to regexp, then pushed into `regexp-search-ring' which will be read by
+`meow-search' and other commands. In this case, REGEXP-FORMAT is used as a
+format-string to format the regexp-quoted selection content (which is passed as
+a string to `format'). Further matches of this formatted search will be
+highlighted in the buffer."
+  (let* ((bounds (bounds-of-thing-at-point thing))
+         (beg (car bounds))
+         (end (cdr bounds)))
+    (when beg
+      (thread-first
+        (meow--make-selection (cons 'expand type) beg end)
+        (meow--select backward))
+      (when (stringp regexp-format)
+        (let ((search (format regexp-format (regexp-quote 
(buffer-substring-no-properties beg end)))))
+          (meow--push-search search)
+          (meow--highlight-regexp-in-buffer search))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; WORD/SYMBOL MOVEMENT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -747,62 +775,65 @@ This command will also provide highlighting for same 
occurs.
 
 Use negative argument to create a backward selection."
   (interactive "p")
-  (let* ((bounds (bounds-of-thing-at-point 'word))
-         (beg (car bounds))
-         (end (cdr bounds)))
-    (when beg
-      (thread-first
-        (meow--make-selection '(expand . word) beg end)
-        (meow--select (< n 0)))
-      (let ((search (format "\\<%s\\>" (regexp-quote 
(buffer-substring-no-properties beg end)))))
-        (meow--push-search search)
-        (meow--highlight-regexp-in-buffer search)))))
+  (meow-mark-thing meow-word-thing 'word (< n 0) "\\<%s\\>"))
 
 (defun meow-mark-symbol (n)
   "Mark current symbol under cursor.
 
 This command works similar to `meow-mark-word'."
   (interactive "p")
-  (let* ((bounds (bounds-of-thing-at-point 'symbol))
-         (beg (car bounds))
-         (end (cdr bounds)))
-    (when beg
-      (thread-first
-        (meow--make-selection '(expand . word) beg end)
-        (meow--select (< n 0)))
-      (let ((search (format "\\_<%s\\_>" (regexp-quote 
(buffer-substring-no-properties beg end)))))
-        (meow--push-search search)
-        (meow--highlight-regexp-in-buffer search)))))
+  (meow-mark-thing meow-symbol-thing 'word (< n 0) "\\_<%s\\_>"))
 
-(defun meow--forward-symbol-1 ()
-  (when (forward-symbol 1)
-    (meow--hack-cursor-pos (point))))
+(defun meow--forward-thing-1 (thing)
+  (let ((pos (point)))
+    (forward-thing thing 1)
+    (when (not (= pos (point)))
+      (meow--hack-cursor-pos (point)))))
 
-(defun meow--backward-symbol-1 ()
+(defun meow--backward-thing-1 (thing)
   (let ((pos (point)))
-    (forward-symbol -1)
+    (forward-thing thing -1)
     (when (not (= pos (point)))
       (point))))
 
-(defun meow--fix-word-selection-mark (pos mark)
-  "Return new mark for a word select.
+(defun meow--fix-thing-selection-mark (thing pos mark)
+  "Return new mark for a selection of THING.
 This will shrink the word selection only contains
  word/symbol constituent character and whitespaces."
   (save-mark-and-excursion
-    (goto-char pos)
-    (if (> mark pos)
-        (progn (skip-syntax-forward "-_w" mark)
-               (point))
-      (skip-syntax-backward "-_w" mark)
-      (point))))
-
-(defun meow--forward-word-1 ()
-  (when (forward-word)
-    (meow--hack-cursor-pos (point))))
-
-(defun meow--backward-word-1 ()
-  (when (forward-word -1)
-    (point)))
+    (goto-char
+     (if (> mark pos) pos
+       ;; Point must be before the end of the word to get the bounds correctly
+       (1- pos)))
+    (let ((bounds (bounds-of-thing-at-point thing)))
+      (if (> mark pos)
+          (cdr bounds)
+        (car bounds)))))
+
+(defun meow-next-thing (thing type n)
+  "Create non-expandable selection of TYPE to the end of the next Nth THING.
+
+If N is negative, select to the beginning of the previous Nth thing instead."
+  (unless (equal type (cdr (meow--selection-type)))
+    (meow--cancel-selection))
+  (let* ((expand (equal (cons 'expand type) (meow--selection-type)))
+         (_ (when expand
+              (if (< n 0) (meow--direction-backward)
+                (meow--direction-forward))))
+         (new-type (if expand (cons 'expand type) (cons 'select type)))
+         (m (point))
+         (p (save-mark-and-excursion
+              (forward-thing thing n)
+              (unless (= (point) m)
+                (point)))))
+    (when p
+      (thread-first
+        (meow--make-selection
+         new-type (meow--fix-thing-selection-mark thing p m) p expand)
+        (meow--select))
+      (meow--maybe-highlight-num-positions
+       (cons (apply-partially #'meow--backward-thing-1 thing)
+             (apply-partially #'meow--forward-thing-1 thing))))))
 
 (defun meow-next-word (n)
   "Select to the end of the next Nth word.
@@ -818,20 +849,7 @@ To select continuous words, use following approaches:
 3. use `meow-expand' after this command.
 "
   (interactive "p")
-  (unless (equal 'word (cdr (meow--selection-type)))
-    (meow--cancel-selection))
-  (let* ((expand (equal '(expand . word) (meow--selection-type)))
-         (_ (when expand (meow--direction-forward)))
-         (type (if expand '(expand . word) '(select . word)))
-         (m (point))
-         (p (save-mark-and-excursion
-              (when (forward-word n)
-                (point)))))
-    (when p
-      (thread-first
-        (meow--make-selection type (meow--fix-word-selection-mark p m) p 
expand)
-        (meow--select))
-      (meow--maybe-highlight-num-positions '(meow--backward-word-1 . 
meow--forward-word-1)))))
+  (meow-next-thing meow-word-thing 'word n))
 
 (defun meow-next-symbol (n)
   "Select to the end of the next Nth symbol.
@@ -847,20 +865,7 @@ To select continuous symbols, use following approaches:
 
 3. use `meow-expand' after this command."
   (interactive "p")
-  (unless (equal 'word (cdr (meow--selection-type)))
-    (meow--cancel-selection))
-  (let* ((expand (equal '(expand . word) (meow--selection-type)))
-         (_ (when expand (meow--direction-forward)))
-         (type (if expand '(expand . word) '(select . word)))
-         (m (point))
-         (p (save-mark-and-excursion
-              (when (forward-symbol n)
-                (point)))))
-    (when p
-      (thread-first
-        (meow--make-selection type (meow--fix-word-selection-mark p m) p 
expand)
-        (meow--select))
-      (meow--maybe-highlight-num-positions '(meow--backward-symbol-1 . 
meow--forward-symbol-1)))))
+  (meow-next-thing meow-symbol-thing 'word n))
 
 (defun meow-back-word (n)
   "Select to the beginning the previous Nth word.
@@ -868,20 +873,7 @@ To select continuous symbols, use following approaches:
 A non-expandable word selection will be created.
 This command works similar to `meow-next-word'."
   (interactive "p")
-  (unless (equal 'word (cdr (meow--selection-type)))
-    (meow--cancel-selection))
-  (let* ((expand (equal '(expand . word) (meow--selection-type)))
-         (_ (when expand (meow--direction-backward)))
-         (type (if expand '(expand . word) '(select . word)))
-         (m (point))
-         (p (save-mark-and-excursion
-              (when (backward-word n)
-                (point)))))
-    (when p
-      (thread-first
-        (meow--make-selection type (meow--fix-word-selection-mark p m) p 
expand)
-        (meow--select))
-      (meow--maybe-highlight-num-positions '(meow--backward-word-1 . 
meow--forward-word-1)))))
+  (meow-next-thing meow-word-thing 'word (- n)))
 
 (defun meow-back-symbol (n)
   "Select to the beginning the previous Nth symbol.
@@ -889,21 +881,7 @@ This command works similar to `meow-next-word'."
 A non-expandable word selection will be created.
 This command works similar to `meow-next-symbol'."
   (interactive "p")
-  (unless (equal 'word (cdr (meow--selection-type)))
-    (meow--cancel-selection))
-  (let* ((expand (equal '(expand . word) (meow--selection-type)))
-         (_ (when expand (meow--direction-backward)))
-         (type (if expand '(expand . word) '(select . word)))
-         (m (point))
-         (p (save-mark-and-excursion
-              (forward-symbol (- n))
-              (unless (= (point) m)
-                (point)))))
-    (when p
-      (thread-first
-        (meow--make-selection type (meow--fix-word-selection-mark p m) p 
expand)
-        (meow--select))
-      (meow--maybe-highlight-num-positions '(meow--backward-symbol-1 . 
meow--forward-symbol-1)))))
+  (meow-next-thing meow-symbol-thing 'word (- n)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; LINE SELECTION
diff --git a/meow-thing.el b/meow-thing.el
index c8bd070f8e..2a674f9dbb 100644
--- a/meow-thing.el
+++ b/meow-thing.el
@@ -24,7 +24,7 @@
 (require 'meow-util)
 
 (defun meow--bounds-of-symbol ()
-  (when-let (bounds (bounds-of-thing-at-point 'symbol))
+  (when-let (bounds (bounds-of-thing-at-point meow-symbol-thing))
     (let ((beg (car bounds))
           (end (cdr bounds)))
       (save-mark-and-excursion
@@ -56,7 +56,7 @@ The thing `string' is not available in Emacs 27.'"
     (bounds-of-thing-at-point 'string)))
 
 (defun meow--inner-of-symbol ()
-  (bounds-of-thing-at-point 'symbol))
+  (bounds-of-thing-at-point meow-symbol-thing))
 
 (defun meow--bounds-of-string (&optional inner)
   (when-let (bounds (meow--bounds-of-string-1))
@@ -310,7 +310,7 @@ PAIR-EXPR contains two string token lists. The tokens in 
first
 
 (meow-thing-register 'defun 'defun 'defun)
 
-(meow-thing-register 'symbol #'meow--inner-of-symbol #'meow--bounds-of-symbol)
+(meow-thing-register meow-symbol-thing #'meow--inner-of-symbol 
#'meow--bounds-of-symbol)
 
 (meow-thing-register 'string #'meow--inner-of-string #'meow--bounds-of-string)
 
diff --git a/meow-var.el b/meow-var.el
index 1fc5cfe08b..3b4c0f9d29 100644
--- a/meow-var.el
+++ b/meow-var.el
@@ -136,6 +136,34 @@ This will affect how selection is displayed."
   :type '(alist :key-type (symbol :tag "Command")
                 :key-value (symbol :tag "Direction")))
 
+(defvar meow-word-thing 'word
+  "The \\='thing\\=' used for marking and movement by words.
+
+The values is a \\='thing\\=' as understood by `thingatpt' - a symbol that will
+be passed to `forward-thing' and `bounds-of-thing-at-point', which see.
+
+This means that they must, at minimum, have a function as the value of their
+`forward-op' symbol property (or the function should be defined as
+`forward-SYMBOLNAME'). This function should accept a single argument, a number
+N, and should move over the next N things, in either the forward or backward
+direction depending on the sign of N. Examples of such functions include
+`forward-word', `forward-symbol' and `forward-sexp', which `thingatpt' uses for
+the `word', `symbol' and `sexp' things, respectively.")
+
+(defvar meow-symbol-thing 'symbol
+  "The \\='thing\\=' used for marking and movement by symbols.
+
+The values is a \\='thing\\=' as understood by `thingatpt' - a symbol that will
+be passed to `forward-thing' and `bounds-of-thing-at-point', which see.
+
+This means that they must, at minimum, have a function as the value of their
+`forward-op' symbol property (or the function should be defined as
+`forward-SYMBOLNAME'). This function should accept a single argument, a number
+N, and should move over the next N things, in either the forward or backward
+direction depending on the sign of N. Examples of such functions include
+`forward-word', `forward-symbol' and `forward-sexp', which `thingatpt' uses for
+the `word', `symbol' and `sexp' things, respectively.")
+
 (defcustom meow-display-thing-help t
   "Whether to display the help prompt for 
meow-inner/bounds/begin/end-of-thing."
   :group 'meow

Reply via email to