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

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