|
@@ -29,24 +29,8 @@
|
29
|
29
|
(defvar *commands* '("to"))
|
30
|
30
|
(defvar *maildir* nil)
|
31
|
31
|
|
32
|
|
-; Thanks to http://cl-cookbook.sourceforge.net/strings.html#manip
|
33
|
|
-(defun replace-all (string part replacement &key (test #'char=))
|
34
|
|
- "Returns a new string in which all the occurences of the part
|
35
|
|
- is replaced with replacement."
|
36
|
|
- (with-output-to-string (out)
|
37
|
|
- (loop with part-length = (length part)
|
38
|
|
- for old-pos = 0 then (+ pos part-length)
|
39
|
|
- for pos = (search part string
|
40
|
|
- :start2 old-pos
|
41
|
|
- :test test)
|
42
|
|
- do (write-string string out
|
43
|
|
- :start old-pos
|
44
|
|
- :end (or pos (length string)))
|
45
|
|
- when pos do (write-string replacement out)
|
46
|
|
- while pos)))
|
47
|
|
-
|
48
|
|
-; This function is pretty ugly but I was tired when I wrote it and just wanted it to work.
|
49
|
|
-; TODO: Clean this up
|
|
32
|
+;; This function is pretty ugly but I was tired when I wrote it and just wanted it to work.
|
|
33
|
+;; TODO: Clean this up
|
50
|
34
|
(defun split-quoted (str)
|
51
|
35
|
(let ((my-list nil)
|
52
|
36
|
(my-string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
|
|
@@ -66,7 +50,7 @@
|
66
|
50
|
(defun check-start (line expected seperator)
|
67
|
51
|
(if (or (empty-string? line) (empty-string? seperator))
|
68
|
52
|
nil
|
69
|
|
- (string= expected (first (split line seperator)))))
|
|
53
|
+ (string= expected (first (split-sequence:split-sequence seperator line)))))
|
70
|
54
|
|
71
|
55
|
(defun test-for-maildir (line)
|
72
|
56
|
(check-start line "MAILDIR" "="))
|
|
@@ -85,11 +69,11 @@
|
85
|
69
|
until (or (eq line 'eof) (funcall test-func line))))
|
86
|
70
|
|
87
|
71
|
(defun convert-maildir-value (value)
|
88
|
|
- (remove #\" (replace-all value "${HOME}" (to-string (user-homedir-pathname)))))
|
|
72
|
+ (remove #\" (cl-ppcre:regex-replace-all "${HOME}" value (user-homedir-pathname))))
|
89
|
73
|
|
90
|
74
|
(defun set-maildir (line hash)
|
91
|
|
- (let ((maildir (convert-maildir-value (car (last (split line "="))))))
|
92
|
|
- (sethash "maildir" hash maildir)
|
|
75
|
+ (let ((maildir (convert-maildir-value (car (last (split-sequence:split-sequence "=" line))))))
|
|
76
|
+ (setf (gethash "maildir" hash) maildir)
|
93
|
77
|
(setf *maildir* maildir)))
|
94
|
78
|
|
95
|
79
|
(defun parse-line (s line hash)
|
|
@@ -103,31 +87,32 @@
|
103
|
87
|
|
104
|
88
|
(defun clean-line (line)
|
105
|
89
|
(let ((cleaned-line (string-trim '(#\Space #\Tab) line)))
|
106
|
|
- (replace-all cleaned-line "${MAILDIR}" *maildir*)))
|
|
90
|
+ (cl-ppcre:regex-replace-all "${MAILDIR}" cleaned-line *maildir*)))
|
107
|
91
|
|
108
|
92
|
(defun hash-add-command (line hash)
|
109
|
93
|
(let* ((cleaned-line (clean-line line))
|
110
|
94
|
(line-list (split-quoted cleaned-line)))
|
111
|
|
- (sethash "command" hash (first line-list))
|
112
|
|
- (sethash "args" hash (subseq line-list 1))
|
|
95
|
+ (setf (gethash "command" hash) (first line-list))
|
|
96
|
+ (setf (gethash "args" hash) (subseq line-list 1))
|
113
|
97
|
hash))
|
114
|
98
|
|
115
|
99
|
(defun get-regex (line)
|
116
|
|
- (second (split line "/")))
|
|
100
|
+ (second (split-sequence:split-sequence "/" line)))
|
117
|
101
|
|
118
|
102
|
(defun make-regex-hash (regex)
|
119
|
103
|
(let ((regex-hash (make-hash-table :test 'equal)))
|
120
|
|
- (sethash "regex" regex-hash regex)
|
|
104
|
+ (setf (gethash "regex" regex-hash) regex)
|
121
|
105
|
regex-hash))
|
122
|
106
|
|
123
|
107
|
(defun parse-if-line (line hash)
|
124
|
108
|
(if (test-for-if line)
|
125
|
109
|
(let* ((regex (get-regex line))
|
126
|
110
|
(regex-hash (make-regex-hash regex)))
|
127
|
|
- (sethash "patterns" hash (append (gethash "patterns" hash) (list regex-hash)))
|
|
111
|
+ (setf (gethash "patterns" hash) (append (gethash "patterns" hash) (list regex-hash)))
|
128
|
112
|
regex-hash)))
|
129
|
113
|
|
130
|
114
|
(defun parse-inner-if-line (s line hash)
|
|
115
|
+ (declare (ignore s) )
|
131
|
116
|
(if (test-for-command line)
|
132
|
117
|
(hash-add-command line hash)))
|
133
|
118
|
|
|
@@ -138,5 +123,5 @@
|
138
|
123
|
(defun read-mailfilter-file (file)
|
139
|
124
|
(let ((hash (make-hash-table :test 'equal)))
|
140
|
125
|
(with-open-file (s file)
|
141
|
|
- (loop-file-until s (lambda (x) nil) #'parse-line hash))
|
|
126
|
+ (loop-file-until s (lambda (x) (declare (ignore x))) #'parse-line hash))
|
142
|
127
|
hash))
|