What was the original question posed by your teacher?
Show us what have you developed so far.
(defun vk_StringSubstPat (NewPattern Pattern String / Pos NewPatternLen)
(setq NewPatternLen (strlen NewPattern))
(while (setq Pos (vl-string-search Pattern String Pos))
(setq String (vl-string-subst NewPattern Pattern String Pos))
(setq Pos (+ Pos NewPatternLen))
)
String
)
(mapcar
(function
(lambda (s)
(read (strcat "(\"" (vk_StringSubstPat "\"\"" "*" (vl-string-trim "*" s)) "\")")
)
)
)
(list "*jsyq_g_list*G1*G2*G3*G4*G5*"
"*jsyq_p_list*P1*P2*P3*P4*P5*P6*"
"*jsyq_e_list*E1*E2*E3*E4*E5*E6*E7*"
"*jsyq_m_list*M1*M2*M3*M4*M5*M6*M7*M8*"
"*jsyq_h_list*H1*H2*H3*H4*H5*H6*H7*H8*H9*"
"*jsyq_b_list*B1*B2*B3*B4*B5*B6*B7*B8*B9*B10*"
)
)
Code: [Select](defun vk_StringSubstPat (NewPattern Pattern String / Pos NewPatternLen)
(setq NewPatternLen (strlen NewPattern))
(while (setq Pos (vl-string-search Pattern String Pos))
(setq String (vl-string-subst NewPattern Pattern String Pos))
(setq Pos (+ Pos NewPatternLen))
)
String
)
(mapcar
(function
(lambda (s)
(read (strcat "(\"" (vk_StringSubstPat "\"\"" "*" (vl-string-trim "*" s)) "\")")
)
)
)
(list "*jsyq_g_list*G1*G2*G3*G4*G5*"
"*jsyq_p_list*P1*P2*P3*P4*P5*P6*"
"*jsyq_e_list*E1*E2*E3*E4*E5*E6*E7*"
"*jsyq_m_list*M1*M2*M3*M4*M5*M6*M7*M8*"
"*jsyq_h_list*H1*H2*H3*H4*H5*H6*H7*H8*H9*"
"*jsyq_b_list*B1*B2*B3*B4*B5*B6*B7*B8*B9*B10*"
)
)
(defun StringStrip (str)
;; Lee Mac ~ 01.04.10
(defun StringParser (str del)
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos)
(StringParser (substr str (+ pos 1 (strlen del))) del))
(list str)))
(StringParser (vl-string-trim "*" str) "*"))
(StringStrip "*jsyq_g_list*G1*G2*G3*G4*G5*")
==> ("jsyq_g_list" "G1" "G2" "G3" "G4" "G5")
;;; Convert string to list, based on separator
;;; #Str - String to convert
;;; #Sep - Separator to break string into items
;;; Ex. - (AT:Str2Lst "1,2,3" ",") -> '("1" "2" "3")
;;; Alan J. Thompson, 11.11.09 / 04.01.10
(defun AT:Str2Lst (#Str #Sep / #Inc #List #Str)
(while (setq #Inc (vl-string-search #Sep #Str))
(setq #List (cons (substr #Str 1 #Inc) #List))
(setq #Str (substr #Str (+ 2 #Inc)))
) ;_ while
(vl-remove "" (reverse (cons #Str #List)))
) ;_ defun
(at:str2lst "*jsyq_g_list*G1*G2*G3*G4*G5*" "*")
("jsyq_g_list" "G1" "G2" "G3" "G4" "G5")
;;++++++++++++++++++
;; parser by CAB
;;++++++++++++++++++
(defun sparser (str delim / ptr lst)
(while (setq ptr (vl-string-search delim str))
(setq lst (cons (substr str 1 ptr) lst))
(setq str (substr str (+ ptr 2)))
)
(reverse (cons str lst))
)
;;; Convert List to String
;;; L - List to process
;;; S - Separator
;;; Ex. (AT:Lst2Str '("A" "B" "C") ",") -> "A,B,C"
;;; Alan J. Thompson, 04.01.10
(defun AT:Lst2Str (L S)
(if (cdr L)
(strcat (vl-princ-to-string (car L)) S (AT:Lst2Str (cdr L) S))
(vl-princ-to-string (car L))
) ;_ if
) ;_ defun
(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c")))
Here is another way Alan.Code: [Select](apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c")))
Granted you convert yours to a string, but that is easy enough also.
((lambda ( s ) (substr s 1 (1- (strlen s))))(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c"))))
Thought that might be a concern. Oh well. But in the interest of cat skinning.Nice.Code: [Select]((lambda ( s ) (substr s 1 (1- (strlen s))))(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c"))))
(substr (apply 'strcat (mapcar (function (lambda ( a ) (strcat "," a))) '("a" "b" "c"))) 2)
(mapcar (function (lambda(x) (setq str (cond (str (strcat str "," x))(x))))) strlist)
(apply 'strcat (mapcar 'strcat '("a" "b" "c") '("," "," "")))
(defun Str-Make (lst del / str x)
(setq str (car lst))
(foreach x (cdr lst) (setq str (strcat str del x)))
str)
(defun Str-Make (lst del / str)
(setq str (car lst))
(while (setq lst (cdr lst)) (setq str (strcat str del (car lst))))
str)
Very cool Lee! And to think, I was pretty happy with my recursive one.Code: [Select](defun Str-Make (lst del / str x)
(setq str (car lst))
(foreach x (cdr lst) (setq str (strcat str del x)))
str)Code: [Select](defun Str-Make (lst del / str)
(setq str (car lst))
(while (setq lst (cdr lst)) (setq str (strcat str del (car lst))))
str)
Very cool Lee! And to think, I was pretty happy with my recursive one.
(defun Str-Make (lst del / str)
(mapcar (function (lambda(s) (setq str (if str (strcat str del s) s)))) lst)
str
)
(defun Str-Make (lst del / str f)
(apply 'strcat (mapcar (function (lambda (s) (setq f (if f (strcat del s) s)))) lst))
)
:?
Another :-)Code: [Select](defun StringStrip (str)
;; Lee Mac ~ 01.04.10
(defun StringParser (str del)
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos)
(StringParser (substr str (+ pos 1 (strlen del))) del))
(list str)))
(StringParser (vl-string-trim "*" str) "*"))Code: [Select](StringStrip "*jsyq_g_list*G1*G2*G3*G4*G5*")
==> ("jsyq_g_list" "G1" "G2" "G3" "G4" "G5")
;;;by qjchen@gmail.com
(defun q:str:delim(str delim / l1 l2)
(setq str (vl-string->list str) delim (vl-string->list delim))
(while str
(if (not (member (car str) delim))
(setq l1 (cons (car str) l1))
(if l1 (setq l2 (cons (vl-list->string (reverse l1)) l2) l1 nil))
)
(setq str (cdr str))
)
(if l1 (setq l2 (cons (vl-list->string (reverse l1)) l2)))
(reverse l2)
)
(q:str:delim "a,bb c\tdd\ne" " ,\t\n")
(q:str:delim "a,bb c\tdd\ne" " ,\t\n")=> ("a" "bb" "c" "dd" "e")(defun STD-STRING->LIST (s / lst)
(if (= (type s) 'STR)
(while (/= s "")
(setq lst (cons (ascii (substr s 1 1)) lst) s (substr s 2))
)
)
(reverse lst)
)
(defun STD-STRTOK (s delims / len s1 i c lst)
(setq delims (std-string->list delims)
len (strlen s) s1 "" i (1+ len)
)
(while (> (setq i (1- i)) 0)
(setq c (substr s i 1))
(if (member (ascii c) delims)
(if (/= s1 "") (setq lst (cons s1 lst) s1 ""))
(setq s1 (strcat c s1))
)
)
(if (/= s1 "") (cons s1 lst) lst)
)
(STD-STRTOK "a,bb c\tdd\ne" " ,\t\n")
Maybe this?
http://www.theswamp.org/index.php?topic=22034.msg265916#msg265916
;;;-------------------strtok------------
;;;creates a list of tokens from a delimited string
;;;delim must be one distinct character, but may be repeated
;;;-----------------------------------------
(defun strtok (str delim / out pos)
(setq delim (ascii delim))
(while (setq pos (vl-string-position delim str))
(if (> pos 0);not just adjacent delimiters
(setq out (cons (substr str 1 pos) out))
)
(setq str (substr str (+ 2 pos)))
)
(if (> (strlen str) 0);not a trailing delimiter
(reverse (cons str out))
(reverse out)
)
);strtok
Command: (strtok "*jsyq_p_list*P1*P2*P3*P4*P5*P6*" "*")
("jsyq_p_list" "P1" "P2" "P3" "P4" "P5" "P6")
(defun LM:StringParser ( str del )
;; © Lee Mac ~ 14.06.10
(if (setq pos (vl-string-search del str))
(vl-remove ""
(cons (substr str 1 pos)
(LM:StringParser
(substr str (+ pos 1 (strlen del))) del
)
)
)
(list str)
)
)