Return text from wcmatch

March 6, 2020

Hi all,

Does anyone know how to get wcmatch to return the matching text rather than T? I figured maybe someone has something on site that I just can't find.

If there's none, I'll just build one myself (and hopefully share it in here for all to use).

Thanks,

Jonathan Handojo

March 6, 2020

wcmatch is only testing if a match exists. If you want something else look into vl-string-mismatch or vl-string-search

March 6, 2020

Something like this?

(setq text "Jonathan")
(setq var (if (wcmatch text "Jona*") text nil))

March 6, 2020

15 minutes ago, fuccaro said:
Something like this?
(setq text "Jonathan")
(setq var (if (wcmatch text "Jona*") text nil))

well that's so obvious I was thinking / hoping OP wants something more complex

March 6, 2020

Yes, we must wait now for OP's reply...

March 6, 2020

Assuming that you are looking to return the smallest section of the string which matches the supplied pattern, you could use a function such as the following:

(defun LM:wcmatchx ( str pat )
    (if (wcmatch str pat)
        (cond
            (   (LM:wcmatchx (substr str 2) pat))
            (   (LM:wcmatchx (substr str 1 (1- (strlen str))) pat))
            (   str   )
        )
    )
)

For example:

_$ (LM:wcmatchx "abc123def" "*###*")
"123"

But this relatively simplistic approach isn't bulletproof and may not be applicable to all conceivable wcmatch pattern & string combinations.

A more robust approach might be to turn to Regular Expressions and use the Execute method.

March 7, 2020

15 hours ago, Lee Mac said:
Assuming that you are looking to return the smallest section of the string which matches the supplied pattern, you could use a function such as the following:
(defun LM:wcmatchx ( str pat )
    (if (wcmatch str pat)
        (cond
            (   (LM:wcmatchx (substr str 2) pat))
            (   (LM:wcmatchx (substr str 1 (1- (strlen str))) pat))
            (   str   )
        )
    )
)
For example:
_$ (LM:wcmatchx "abc123def" "*###*")
"123"
But this relatively simplistic approach isn't bulletproof and may not be applicable to all conceivable wcmatch pattern & string combinations.

A more robust approach might be to turn to Regular Expressions and use the Execute method.

Yeah, I kinda thought it wasn't easy to do that.

Btw Lee,

(LM:wcmatchx "abc123def" "~abc")

Doesn't really like that one.

;; ----------------------------------------------------------------------------------------------------------------------------------------------------;;

Idk if I've been wasting my time with this, but I actually came up with this myself:

;; JH:str->lst-escape_delimiter --> Jonathan Handojo
;; Parses a string to a list with a supplied delimiter, excluding delimiters with an escape character
;; str - string to parse
;; del - delimiter character
;; esc - escape character placed before the delimiter
;; Example call:
;; _$ (JH:str->lst-escape_delimiter "1,2,3`,4`,5,67,89`,100`,101" "," "`")
;; ("1" "2" "3,4,5" "67" "89,100,101")

(defun JH:str->lst-escape_delimiter (str del esc / nstr sstr final put)
  (setq put "")
  (while (setq nstr (vl-string-search del str))
    (cond
      ((vl-catch-all-error-p
	   (vl-catch-all-apply
	     'substr
	     (list
	       (setq sstr (substr str 1 nstr))
	       (strlen sstr)
	       )
	     )
	   )
       (setq final (cons put final)
	     put ""
	     )
       )
      ((eq (substr (setq sstr (substr str 1 nstr)) (strlen sstr)) esc)
       (setq put (strcat put (substr sstr 1 (1- (strlen sstr))) del))
       )
      (
       (setq final (cons (strcat put (substr sstr 1 (strlen sstr))) final)
	     put ""
	     )
       )
      )
    (setq str (substr str (+ nstr 2)))
    )
  (reverse (cons (strcat put str) final))
  )

;; JH:range --> Jonathan Handojo
;; Returns a list of numbers between x and y
;; Example call:
;; _$ (JH:range 12 19)
;; (12 13 14 15 16 17 18 19)

(defun JH:range (x y / final)
  (repeat (- (1+ y) x)
    (setq final (cons x final)
	  x (1+ x))
    )
  (reverse final)
  )

;; JH:wcmatchtext --> Jonathan Handojo
;; Returns the true text supplied by wcmatch.
;; str - string to test
;; pat - test pattern
;; rtn - the return value if no match is found
;; -------------------------------------------------------------
;; If an asterisk is used at the beginning or end of the pattern,
;; the function returns inclusive of the following pattern.
;; It can also be placed at the middle of the pattern.
;; Without asterisk, the function will return the nearest match

;; Example calls:

;; _$ (JH:wcmatchtext "Test run" "Te@@ ?" "")
;; "Test r"

;; _$ (JH:wcmatchtext "234-abRT" "#[1-7]?.@[atdb][~A-EG-P][E-U]" "")
;; "234-abRT"

;; _$ (JH:wcmatchtext "Jonathan" "a?[~f-j],[g-p]@t?*" "")
;; "nathan"

;; _$ (JH:wcmatchtext "47882,STOpp" "[6-9][1-4]`,@?[~AUSG-N]" "")
;; "82,STO"

;; _$ (JH:wcmatchtext "Let's go" "~e?.[arsc],@.[r-v]*" "")
;; "t's go"

;; _$ (JH:wcmatchtext "Not found" "?..?" "")
;; ""

(defun JH:wcmatchtext ; Still a few bugs with asterisk, need a bit more fix up
       (
	str
	pat
	rtn
	/
	)
  (cond
    (
     (vl-some
       '(lambda (x / tst closed nexpat nextmch patt org inpatt)
	  (mapcar 'set '(tst patt org mtch) (list str (if (wcmatch x "`~*") (substr x 2) x) str ""))
	  (while
	    (progn
	      (cond
		((wcmatch patt "``*")
		 (mapcar 'set
			 '(tst patt mtch)
			 (list
			   (substr tst 2)
			   (substr patt 3)
			   (strcat mtch (substr tst 1 1))
			   )
			 )
		 )
		((wcmatch patt "`[*")
		 (if (setq closed (vl-string-search "]" patt))
		   (progn
		     (setq inpatt (substr patt 2 (1- closed)))
		     (while (wcmatch inpatt "*[~~]`-?*")
		       (setq inpatt
			      (vl-string-subst
				(apply 'strcat
				       (mapcar 'chr
					       (JH:range
						 (ascii (substr inpatt (vl-string-search "-" inpatt) 1))
						 (ascii (substr inpatt (+ 2 (vl-string-search "-" inpatt)) 1))
						 )
					       )
				       )
				"-"
				inpatt
				)
			     )
		       )
		     (cond
		       ((and (vl-string-search (substr tst 1 1) inpatt) (wcmatch inpatt "~~*"))
			(mapcar 'set
				'(tst patt mtch)
				(list
				  (substr tst 2)
				  (substr patt (+ (vl-string-search "]" patt) 2))
				  (strcat mtch (substr tst 1 1))
				  )
				)
			)
		       ((and (vl-string-search (substr tst 1 1) inpatt) (wcmatch inpatt "`~*"))
			(setq org (substr org 2))
			(mapcar 'set '(tst patt mtch) (list org (if (wcmatch x "`~*") (substr x 2) x) ""))
			)
		       ((and (not (vl-string-search (substr tst 1 1) inpatt)) (wcmatch inpatt "~~*"))
			(setq org (substr org 2))
			(mapcar 'set '(tst patt mtch) (list org (if (wcmatch x "`~*") (substr x 2) x) ""))
			)
		       ((and (not (vl-string-search (substr tst 1 1) inpatt)) (wcmatch inpatt "`~*"))
			(mapcar 'set
				'(tst patt mtch)
				(list
				  (substr tst 2)
				  (substr patt (+ (vl-string-search "]" patt) 2))
				  (strcat mtch (substr tst 1 1))
				  )
				)
			)
		       ((mapcar 'set
				'(tst patt mtch)
				(list
				  (substr tst 2)
				  (substr patt (+ (vl-string-search "]" patt) 2))
				  (strcat mtch (substr tst 1 1))
				  )
				)
			)
		       
		       )
		     )
		   (mapcar 'set
			   '(tst patt mtch)
			   (list
			     (substr tst 2)
			     (substr patt 2)
			     (strcat mtch (substr tst 1 1))
			     )
			   )
		   )
		 )
		((wcmatch patt "`**")
		 (if (not (eq (setq nexpat (substr patt 2 1)) ""))
		   (progn
		     (cond
		       ((member nexpat
				(mapcar 'chr (vl-string->list "#@.*?~-,]"))
				)
			(if (wcmatch tst (strcat nexpat "*")) (setq nexpat (substr tst 1 1)))
			)
		       ((eq nexpat "`") (setq nexpat (substr tst 3 1)))
		       ((eq nexpat "[")
			(if (setq closed (vl-string-search "]" patt))
			  (progn
			    (setq inpatt (substr patt 3 (1- closed)))
			    (while (wcmatch inpatt "*[~~]`-?*")
			      (setq inpatt
				     (vl-string-subst
				       (apply 'strcat
					      (mapcar 'chr
						      (JH:range
							(ascii (substr inpatt (vl-string-search "-" inpatt) 1))
							(ascii (substr inpatt (+ 2 (vl-string-search "-" inpatt)) 1))
							)
						      )
					      )
				       "-"
				       inpatt
				       )
				    )
			      )
			    (if (vl-string-search (substr tst 2 1) inpatt)
			      (setq nexpat (substr tst 2 1))
			      )
			    )
			  )
			)
		       )
		     (if (setq nextmch (vl-string-search nexpat tst))
		       (mapcar 'set
			       '(tst patt mtch)
			       (list
				 (substr tst (1+ nextmch))
				 (substr patt 2)
				 (strcat mtch (substr (if (eq x org) str tst) 1 nextmch))
				 )
			       )
		       (progn (setq org (substr org 2)) (mapcar 'set '(tst patt mtch)
								(list org (if (wcmatch x "`~*") (substr x 2) x) "")))
		       )
		     )
		   (mapcar 'set
			   '(tst patt mtch)
			   (list
			     (substr tst (+ (vl-string-search nexpat tst) 2))
			     (substr patt 2)
			     (strcat mtch (substr tst (1+ (vl-string-search nexpat tst))))
			     )
			   )
		   )
		 )
		((wcmatch patt "[#@.?]*")
		 (if (wcmatch tst (strcat (substr patt 1 1) "*"))
		   (mapcar 'set
			   '(tst patt mtch)
			   (list
			     (substr tst 2)
			     (substr patt 2)
			     (strcat mtch (substr tst 1 1))
			     )
			   )
		   (progn (setq org (substr org 2)) (mapcar 'set '(tst patt mtch)
							    (list org (if (wcmatch x "`~*") (substr x 2) x) "")))
		   )
		 )
		((eq (substr tst 1 1) (substr patt 1 1))
		 (mapcar 'set
			 '(tst patt mtch)
			 (list
			   (substr tst 2)
			   (substr patt 2)
			   (strcat mtch (substr tst 1 1))
			   )
			 )
		 )
		((setq org (substr org 2)) (mapcar 'set '(tst patt mtch) (list org (if (wcmatch x "`~*") (substr x 2) x) "")))
		)
	      
	      (if
		(or
		  (eq patt "")
		  (eq org "")
		  )
		nil
		T
		)
	      )
	    )
	  (cond
	    ((eq patt "") (if (not (wcmatch x "`~*")) mtch))
	    )
	  )
       (JH:str->lst-escape_delimiter pat "," "`")
       )
     )
    (rtn)
    )
  )

There are some bugs when it comes to using the asterisks, but other than that, I believe this will function just like a normal wcmatch by returning the text itself than T.

Thanks,

Jonathan Handojo

Edited March 7, 2020 by Jonathan Handojo

March 7, 2020

2 hours ago, Jonathan Handojo said:
(LM:wcmatchx "abc123def" "~abc")
Doesn't really like that one.

(defun LM:wcmatchx ( str pat )
    (if (and (wcmatch str pat) (/= "" str))
        (cond
            (   (LM:wcmatchx (substr str 2) pat))
            (   (LM:wcmatchx (substr str 1 (1- (strlen str))) pat))
            (   str   )
        )
    )
)

March 7, 2020

I haven't studied your code, but based on your request I coded something like this (I don't know if it's useful to you)...

(defun wcmatchx ( str pat / k )
  (setq k 0)
  (while (and (wcmatch (substr str 1 (setq k (1+ k))) pat) (/= k (strlen str))))
  (cond
    ( (and (wcmatch (substr str k) pat) (= k 1) (/= (substr pat 1 1) "~"))
      str
    )
    ( (and (= (substr str (1+ k)) "") (= (substr pat 1 1) "~") (= str (substr pat 2)))
      nil
    )
    ( (= (substr str (1+ k)) "")
      str
    )
    ( (wcmatch (substr str (1+ k)) pat)
      (substr str (1+ k))
    )
  )
)

(print (wcmatchx "abc123def" "*")) ;;; "abc123def"
(print (wcmatchx "abc123def" "*123*")) ;;; "abc123def"
(print (wcmatchx "abc123def" "~abc")) ;;; "123def"
(print (wcmatchx "abc123def" "~123")) ;;; "abc123def"
(print (wcmatchx "abc123def" "*###*")) ;;; "abc123def"
(princ)

Edited March 8, 2020 by marko_ribar

March 7, 2020

7 hours ago, marko_ribar said:

I haven't studied your code, but based on your request I coded something like this (I don't know if it's useful to you)...


(defun wcmatchx ( str pat / k )
  (setq k 0)
  (while (and (wcmatch (substr str 1 (setq k (1+ k))) pat) (/= k (strlen str))))
  (cond
    ( (= k (strlen str))
      str
    )
    ( (and (wcmatch (substr str k) pat) (= k 1))
      (substr str k)
    )
    ( (wcmatch (substr str (1+ k)) pat)
      (substr str (1+ k))
    )
  )
)

(print (wcmatchx "abc123def" "*")) ;;; "abc123def"
(print (wcmatchx "abc123def" "*123*")) ;;; "abc123def"
(print (wcmatchx "abc123def" "~abc")) ;;; "123def"
(print (wcmatchx "abc123def" "~123")) ;;; "abc123def"
(print (wcmatchx "abc123def" "*###*")) ;;; "abc123def"
(princ)

Well then, what should I write to have your function return "123"?

Based on you and Lee's codes, I've run several tests...

(LM:wcmatchx "Jonathan" "nat") ;nil
(LM:wcmatchx "Jonathan" "nat*") ; nil
(LM:wcmatchx "Jonathan" "*nat*") ; "nat"

(MR:wcmatchx "Jonathan" "nat") ; nil
(MR:wcmatchx "Jonathan" "nat*") ; nil
(MR:wcmatchx "Jonathan" "*nat*") ; "Jonathan"

(JH:wcmatchtext "Jonathan" "nat" "") ; "nat"
(JH:wcmatchtext "Jonathan" "nat*" "") ; "nathan"
(JH:wcmatchtext "Jonathan" "*nat*" "") ; "Jonathan"

(LM:wcmatchx "Let's go everyone" "[a-j][yceom].@?") ; nil
(LM:wcmatchx "Let's go everyone" "[a-j][yceom].@?*") ; nil
(LM:wcmatchx "Let's go everyone" "*[a-j][yceom].@?*") ; go ev

(MR:wcmatchx "Let's go everyone" "[a-j][yceom].@?") ; nil
(MR:wcmatchx "Let's go everyone" "[a-j][yceom].@?*") ; nil
(MR:wcmatchx "Let's go everyone" "*[a-j][yceom].@?*") ; "Let's go everyone"

(JH:wcmatchtext "Let's go everyone" "[a-j][yceom].@?" "") ; "go ev"
(JH:wcmatchtext "Let's go everyone" "[a-j][yceom].@?*" "") ; "go everyone"
(JH:wcmatchtext "Let's go everyone" "*[a-j][yceom].@?*" "") ; "go everyone" (Still buggy with the asterisks)

Btw marko, I've included your initials for your code

The difference between my code and both of yours is mine can detect a match without the use of asterisks. And when used, it returns the completing patterns.

And I can also include a return value of my wish if no match is found (the third argument in my function)

Lee's code returns the section of the string with the closest match.

Marko's code returns the full string if a match is found (except that I don't understand the tilde)

However, my code bugs a little bit if the asterisk is used at the start or middle, but works perfectly fine when placed at the end. Still needs fix.

Thanks

Jonathan Handojo

Edited March 7, 2020 by Jonathan Handojo

March 7, 2020

31 minutes ago, Jonathan Handojo said:

The difference between my code and both of yours is mine can detect a match without the use of asterisks. And when used, it returns the completing patterns.

This seems inconsistent given that -

_$ (wcmatch "Jonathan" "nat")
nil

March 7, 2020

51 minutes ago, Lee Mac said:
This seems inconsistent given that -
_$ (wcmatch "Jonathan" "nat")
nil

Yea, I get what you mean. At times, I just need a function whereby it can return the completing texts. So I thought the asterisk will do the job.

For example, if you have a list of strings (most commonly extracted from a list of subfolders):

1. xxx

2. xxx

3a. xxx

3b. xxx

...

20a. xxx

20b. xxx

where xxx is any value.

Another list can then be:

13 001 xxx

13 002 xxx

14 001 xxx

14 002 xxx

If another user inputs a string (gives a filename) "??????xxx????????" or "???????3a????????" or "???????14 002????????", then you are able to get which string from the list they refer to, and I can then do other stuff with 3a, 14 002 or xxx.

Nonetheless, I totally get what you mean Lee. Perhaps what I posted is nothing close to wcmatch after all, but rather my own function.

Thanks,

Jonathan Handojo

Edited March 7, 2020 by Jonathan Handojo

March 8, 2020

To get "123", I would use combination of LM-MR functions like this :

(defun LM-MR:wcmatchx ( str pat / MR:wcmatchx LM:wcmatchx )

  (defun MR:wcmatchx ( str pat / k )
    (setq k 0)
    (while (and (wcmatch (substr str 1 (setq k (1+ k))) pat) (/= k (strlen str))))
    (cond
      ( (and (wcmatch (substr str k) pat) (= k 1) (/= (substr pat 1 1) "~"))
        str
      )
      ( (and (= (substr str (1+ k)) "") (= (substr pat 1 1) "~") (= str (substr pat 2)))
        nil
      )
      ( (= (substr str (1+ k)) "")
        str
      )
      ( (wcmatch (substr str (1+ k)) pat)
        (substr str (1+ k))
      )
    )
  )

  (defun LM:wcmatchx ( str pat )
    (if (and (wcmatch str pat) (/= "" str))
      (cond
        ( (LM:wcmatchx (substr str 2) pat))
        ( (LM:wcmatchx (substr str 1 (1- (strlen str))) pat))
        ( str )
      )
    )
  )

  (cond
    ( (= pat "*")
      str
    )
    ( (or (= (substr pat 1 1) "*") (= (substr pat (strlen pat)) "*"))
      (LM:wcmatchx str pat)
    )
    ( t
      (MR:wcmatchx str pat)
    )
  )
)

(print (LM-MR:wcmatchx "abc123def" "*")) ;;; "abc123def"
(print (LM-MR:wcmatchx "abc123def" "*123*")) ;;; "123"
(print (LM-MR:wcmatchx "abc123def" "~abc")) ;;; "123def"
(print (LM-MR:wcmatchx "abc123def" "~123")) ;;; "abc123def"
(print (LM-MR:wcmatchx "abc123def" "*###*")) ;;; "123"
(print (LM-MR:wcmatchx "abc123def" "*123def")) ;;; "123def"
(print (LM-MR:wcmatchx "abc123def" "abc123*")) ;;; "abc123"
(print (LM-MR:wcmatchx "abc123def" "Jonathan")) ;;; nil
(princ)

Edited March 8, 2020 by marko_ribar

March 8, 2020

Just saw, I changed my (cond) statement in my (MR:wcmatchx)... You can correct it in your post where you quoted my function (if you want)...

Regards...

Edited March 8, 2020 by marko_ribar

March 8, 2020

1 hour ago, marko_ribar said:

Just saw, I changed my (cond) statement in my (MR:wcmatchx)... You can correct it in your post where you quoted my function (if you want)...

Regards...

Yea, tilde is a tricky one to dodge, because (LM:wcmatchx "Jonathan" "~Jon") or with any pattern that doesn't match would return just the final string. I like the idea that when using tilde, it would remove that matching pattern and leave the rest out in that LM-MR:wcmatchx function.

Man, just imagine the sort of things you can do with this... you can, for example, do (vl-string-subst "" (LM-MR:wcmatchx (setq str "abc123def") "*###*") str) and it doesn't matter what the numbers are.

Sign In

Return text from wcmatch

Recommended Posts

Jonathan Handojo

rlx

fuccaro

rlx

fuccaro

Lee Mac

Jonathan Handojo

Lee Mac

marko_ribar

Jonathan Handojo

Lee Mac

Jonathan Handojo

marko_ribar

marko_ribar

Jonathan Handojo

Join the conversation

Tutorials

Forums

Activity