Recursively check for characters and substitute

[mid-awe]

Hi all,

I am following some expert advice from dgorsman as he described the appropriatness of utilizing XML (just to clear up any questions about what or why).

I'm attempting to scrub my strings for valid XML output. And so, I assembled the sub-function below. The issue is that this goes into an infinite loop. I'm sure the next step is to write this recursively to check for each of the five characters and substitute as necessary. I only included the code below as it is the best explaination of my goal.

(DEFUN XMLify (data)
  (while (OR (VL-STRING-SEARCH "<" data)
	     (VL-STRING-SEARCH ">" data)
	     (VL-STRING-SEARCH "& " data)
	     (VL-STRING-SEARCH "'" data)
	     (VL-STRING-SEARCH "\"" data)
	 )
    (COND
      ((VL-STRING-SEARCH "<" data) (VL-STRING-SUBST "&lt;" "<" data))
      ((VL-STRING-SEARCH ">" data) (VL-STRING-SUBST "&gt;" ">" data))
      ((VL-STRING-SEARCH "& " data) (VL-STRING-SUBST "&amp; " "& " data))
      ((VL-STRING-SEARCH "'" data) (VL-STRING-SUBST "&apos;" "'" data))
      ((VL-STRING-SEARCH "\"" data) (VL-STRING-SUBST "&quot;" "\"" data))
    )
  )
)

 Please help. Thank you in advance for any suggestions.

[mid-awe]

Ok,

I think I've got it. If anyone sees an issue, I would truly appreciate a warning/heads up.

(DEFUN XMLify (data)
  (IF (OR (VL-STRING-SEARCH "<" data)
	  (VL-STRING-SEARCH ">" data)
	  (VL-STRING-SEARCH "& " data)
	  (VL-STRING-SEARCH "'" data)
	  (VL-STRING-SEARCH "\"" data)
      )
    (COND
      ((VL-STRING-SEARCH "<" data) (setq data$ (VL-STRING-SUBST "&lt;" "<" data)) (XMLify data$))
      ((VL-STRING-SEARCH ">" data) (setq data$ (VL-STRING-SUBST "&gt;" ">" data)) (XMLify data$))
      ((VL-STRING-SEARCH "& " data) (setq data$ (VL-STRING-SUBST "&amp; " "& " data)) (XMLify data$))
      ((VL-STRING-SEARCH "'" data) (setq data$ (VL-STRING-SUBST "&apos;" "'" data)) (XMLify data$))
      ((VL-STRING-SEARCH "\"" data) (setq data$ (VL-STRING-SUBST "&quot;" "\"" data)) (XMLify data$))
    )
    (eval data$)
  )
)

 Thank you in advance.

[hmsilva · Accepted solution]

One other (untested)

(defun XMLify (data / new-lst old-lst)
  (setq	old-lst	'("<" ">" "& " "'" "\"")
	new-lst	'("&lt;" "&gt;" "&amp; " "&apos;" "&quot;")
	l	(length old-lst)
  );; setq
  (while (not (minusp (setq l (1- l))))
    (while (vl-string-search (nth l old-lst) data)
      (setq data (vl-string-subst (nth l new-lst) (nth l old-lst) data))
    );; while
  );; while
  data
);; XMLify

HTH

Henrique

[Lee_Mac]

Here are two more:

;; Add Character Entity References  -  Lee Mac
;; Replaces HTML Special Characters with their character entity reference equivalents

(defun LM:addcharentrefs ( str )
    (if (wcmatch str "*[&<>'\"]*")
        (vl-list->string
            (apply 'append
                (mapcar
                    (function
                        (lambda ( c )
                            (cond
                                (
                                    (cdr
                                        (assoc c
                                           '(
                                                (38 38  97 109 112 59)
                                                (60 38 108 116 59)
                                                (62 38 103 116 59)
                                                (39 38  97 112 111 115 59)
                                                (34 38 113 117 111 116 59)
                                            )
                                        )
                                    )
                                )
                                (   (list c)   )
                            )
                        )
                    )
                    (vl-string->list str)
                )
            )
        )
        str
    )
)

Example:

_$ (LM:addcharentrefs "<p>AutoLISP & Visual LISP</p>")
"&lt;p&gt;AutoLISP &amp; Visual LISP&lt;/p&gt;"

As an extension, the following function uses a regular expression negative look-ahead operator and will account for character entity references already present in the string as demonstrated by the example:

;; Add Character Entity References  -  Lee Mac
;; Replaces HTML Special Characters with their character entity reference equivalents

(defun LM:addcharentrefs ( str / err rgx )
    (if (wcmatch str "*[&<>'\"]*")
        (if (setq rgx (vlax-get-or-create-object "vbscript.regexp"))
            (progn
                (setq err
                    (vl-catch-all-apply
                        (function
                            (lambda ( )
                                (vlax-put-property rgx 'global     :vlax-true)
                                (vlax-put-property rgx 'ignorecase :vlax-false)
                                (vlax-put-property rgx 'multiline  :vlax-true)
                                (foreach pair
                                   '(
                                        ("&(?!amp;|lt;|gt;|apos;|quot;)" . "&amp;")
                                        ("<"  . "&lt;")
                                        (">"  . "&gt;")
                                        ("'"  . "&apos;")
                                        ("\"" . "&quot;")
                                    )
                                    (vlax-put-property rgx 'pattern (car pair))
                                    (setq str (vlax-invoke rgx 'replace str (cdr pair)))
                                )
                            )
                        )
                    )
                )
                (vlax-release-object rgx)
                (if (vl-catch-all-error-p err)
                    (prompt (vl-catch-all-error-message err))
                    err
                )
            )
        )
        str
    )
)

Example:

_$ (LM:addcharentrefs "<P>AutoLISP &amp; Visual LISP</P>")
"&lt;p&gt;AutoLISP &amp; Visual LISP&lt;/p&gt;"

(Note that the "&" is not changed to "&")

[mid-awe]

You guys are awesome =D

Thank you. (I'll have to test these in the morning.)

[hgasty1001]

Hi,

A bit late, but this should work too:

(setq	findlist '("<" ">" "& " "'" "\"")
	replist	 '("&lt;" "&gt;" "&amp; " "&apos;" "&quot;")
)

(defun rep(str findlist replist / ret)
  (setq ret str)
  (mapcar '(lambda(x y)(setq ret   (acet-str-replace x y ret))) findlist replist)
  ret
)

Gaston Nunez

[mid-awe]

Thank you Henrique. For a quick and easy solution, I really like this one. And it's fast too. 🙂

My working function creates yet another global that I can clear later but I don't like generating more globals if I can avoid it. I used the "$" symbol for readability so that I know at first sight that it serves a temporary purpose.

[mid-awe]

Thank you Lee.

You must know I have a weakness for Lambda functions 😉

I've been trying to utilize lambda any chance I get. In many places they are still mysterious to me. Thank you for these two great examples where lambdas make sense and not crowbared in as I have been known to do.

[mid-awe]

Gaston, I like the use of the express tools function. Not many folks try to utilize that huge asset. Thank you.

[hmsilva]

You're welcome, mid-awe

If you need to create the data$ global, just change the

  );; while
  data
);; XMLify

to

  );; while
  (setq data$ data)
);; XMLify

HTH

Henrique

[Lee_Mac]

---

@mid-awe wrote:
Thank you Lee.

You must know I have a weakness for Lambda functions 😉

I've been trying to utilize lambda any chance I get. In many places they are still mysterious to me. Thank you for these two great examples where lambdas make sense and not crowbared in as I have been known to do.

---

You're welcome mid-awe

---

@mid-awe wrote:
Gaston, I like the use of the express tools function. Not many folks try to utilize that huge asset. Thank you.

---

Each to their own, but personally, I try to avoid the use of Express Tools functions if at all possible - here are some interesting thoughts on the topic.

[mid-awe]

Thanks for that Lee, I always assumed if it's gotta be on my machine then I should make use of it every way possible; maybe thoughts from a decade ago. I stand corrected, happily. 🙂