(vl-load-com)
(defun sn:leftnthlst (n lst)
;;;返回一个表中的前n个元素的表
;;;示例：(sn:leftnthlst 2 '(1 2 3 4 5 6))；返回表(1 2)
;;;如果输入的n值大于表长返回原表；小于1返回nil
(vl-remove nil
(mapcar '(lambda (x)
(if (>= (setq n (1- n)) 0)
x
nil
)
)
lst
)
)
)
(defun sn:rightnthlst (n lst)
;;;返回一个表中的第n个元素开始的表
;;;示例：(sn:rightnthlst 2 '(1 2 3 4 5 6))；返回表(2 3 4 5 6)
;;;如果输入的n值大于表长返回原表；小于1返回nil
(vl-remove nil
(mapcar '(lambda (x)
(if (> (setq n (1- n)) 0)
nil
x
)
)
lst
)
)
)
;;;定义一个删除指定位置的表内某项,0为第一项
(defun sn:nthremove (n lst / newlst)
;;;示例：(sn:nthremove 2 '(1 2 3 4 5 6))；返回(1 2 4 5 6)
(if (= 0 n)
(cdr lst)
(append (sn:leftnthlst n lst) (sn:rightnthlst (+ 2 n) lst))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun listposandnumber (lst char beforechar / poslst n relst)
;;; (listposandnumber '(92 92 123 92 92 123 49 50 51 125 65 125) 123 92)
(setq n -1)
(mapcar '(lambda (x)
(setq n (1+ n))
(if (equal x char)
(setq poslst (cons n poslst))
)
)
lst
)
(setq poslst (reverse poslst))
;;;(sn:leftnthlst x lst)
(mapcar '(lambda (x / end n0)
(setq n0 0
end nil
)
(mapcar '(lambda (y)
(if (and (equal beforechar y) (null end))
(setq n0 (1+ n0))
(setq end T)
)
)
(reverse (sn:leftnthlst x lst))
)
(cons x n0)
)
poslst
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun makesureispurechar
(strlst char firstorlast num / tmplst end value)
;;; 查找纯字符仅判断strlst里的firstorlast=T为第一个，firstorlast=nil为最后一个
;;; num=0时条件：前无92或有偶数个92 ；num=1时条件：前有奇数个92
;;;
(setq tmplst (listposandnumber strlst char 92))
(mapcar '(lambda (x)
(if (and (equal num (rem (cdr x) 2)) (null end))
(progn (setq value (car x)) (setq end T))
)
)
(if firstorlast
tmplst
(reverse tmplst)
)
)
value
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun removeitem (lst / tmplst n tmp nlst end ne)
(mapcar
'(lambda (x)
(while (setq n (MAKESUREISPURECHAR lst x T 1))
(setq lst (sn:nthremove (1- n) (sn:nthremove n lst)))
)
)
(mapcar 'ascii (list "O" "o" "L" "l" "~" "P"))
)
(mapcar
'(lambda (x)
(while (and (member x lst)
(setq n (MAKESUREISPURECHAR lst x T 1))
(setq ne (MAKESUREISPURECHAR
(sn:rightnthlst (1+ n) lst)
(ascii ";")
T
0
)
)
)
(repeat (+ 2 ne)
(setq lst (sn:nthremove (1- n) lst))
)
)
)
(mapcar 'ascii (list "f" "F" "C" "H" "T" "Q" "W" "A"))
)
lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun filterMtext (str / lst leftlst midlst
rightlst leftpos rightpos tmp n
ne
)
(setq lst (vl-string->list str))
(while (and (setq leftpos (MAKESUREISPURECHAR lst 123 nil 0))
(setq tmp (MAKESUREISPURECHAR
(sn:rightnthlst (1+ leftpos) lst)
125
T
0
)
)
(setq rightpos (+ leftpos tmp))
)
(setq leftlst (sn:leftnthlst leftpos lst))
(setq rightlst (sn:rightnthlst (+ 2 rightpos) lst))
(setq midlst (sn:leftnthlst
(1- tmp)
(sn:rightnthlst (+ 2 leftpos) lst)
)
)
(setq midlst (removeitem midlst))
(setq lst (append leftlst midlst rightlst))
)
(mapcar
'(lambda (x)
(while (and (member x lst)
(setq n (MAKESUREISPURECHAR lst x T 1))
(setq ne (MAKESUREISPURECHAR
(sn:rightnthlst (1+ n) lst)
(ascii ";")
T
0
)
)
)
(setq lst (sn:nthremove (+ ne n) lst))
(setq lst (sn:nthremove (1- n) (sn:nthremove n lst)))
)
)
(mapcar 'ascii (list "S"))
)
(mapcar
'(lambda (x)
(while (and (member x lst)
(setq n (MAKESUREISPURECHAR lst x T 1))
(setq ne (MAKESUREISPURECHAR
(sn:rightnthlst (1+ n) lst)
(ascii ";")
T
0
)
)
)
(repeat (+ 2 ne)
(setq lst (sn:nthremove (1- n) lst))
)
)
)
(mapcar 'ascii (list "f" "F" "C" "H" "T" "Q" "W" "A"))
)
(mapcar
'(lambda (x)
(while (setq n (MAKESUREISPURECHAR lst x T 1))
(setq lst (sn:nthremove (1- n) (sn:nthremove n lst)))
)
)
(mapcar 'ascii (list "P"))
)
(vl-list->string lst)
)