Allow custom 'word', 'symbol' definitions

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

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))

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,63 +865,23 @@ 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.
 
 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.
 
 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

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)
 

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