Added files for new filters.

tree-edit.el contains basic functions for editing trees. Mostly working.
filter-new.el contains basic functions for filters. Compilation works.
filter-new-edit.el is for editing filters. Untested and unfinished.

src/ChangeLog

+2001-05-02  David Byers  <davby@ida.liu.se>
+
+	* filter-new-edit.el: New file. Contains the new filter editor.
+	Very little is done. Transformation to and from editable trees
+	seems to work.
+
+	* filter-new.el: New file. Contains basic functions for compiling
+	and evaluating new-style filters. The compiler appears to be
+	working. Filter evaluation is untested. The extension mechanisms
+	work.
+
+	* tree-edit.el: New file. Contains basic functionality for editing
+	trees. What's there seems to work fine. Currently dependent on
+	LysKOM, but easy to free of such dependencies.
+
 2001-04-25  David Byers  <davby@ida.liu.se>
 
 	* async.el (lyskom-parse-async): Update name of conference in

src/filter-new-edit.el

+;;;;; -*-coding: iso-8859-1;-*-
+;;;;;
+;;;;; $Id$
+;;;;; Copyright (C) 2001  Lysator Academic Computer Association.
+;;;;;
+;;;;; This file is part of the LysKOM server.
+;;;;; 
+;;;;; LysKOM is free software; you can redistribute it and/or modify it
+;;;;; under the terms of the GNU General Public License as published by 
+;;;;; the Free Software Foundation; either version 2, or (at your option) 
+;;;;; any later version.
+;;;;; 
+;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
+;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;;;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;;;;; for more details.
+;;;;; 
+;;;;; You should have received a copy of the GNU General Public License
+;;;;; along with LysKOM; see the file COPYING.  If not, write to
+;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
+;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+;;;;; MA 02139, USA.
+;;;;;
+;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
+;;;;;
+;;;; ================================================================
+;;;; ================================================================
+;;;;
+;;;; File: filter-new-edit.el
+;;;;
+;;;; Filter editor for new style filters.
+;;;;
+
+
+(setq lyskom-clientversion-long 
+      (concat lyskom-clientversion-long
+	      "$Id$\n"))
+
+
+
+(defvar lyskom-filter-edit-all-entries nil
+  "List of all filter edit entries in a filter edit buffer.")
+
+
+;;; ============================================================
+;;; Datatypes
+
+(def-komtype filter-edit-entry
+  name
+  permanent
+  action
+  start
+  end
+  header-end
+  collapsed
+  pattern
+  tree
+  )
+
+
+
+;;; ============================================================
+;;; Transforming to and from the tree editor
+;;;
+
+(defun lyskom-filter-edit-create-tree-data (pattern &optional negated)
+  "Create a list representation of filter pattern PATTERN.
+The list is suitable as input to tree-edit-compile-tree."
+  (cond ((null pattern) nil)
+        (t (let* ((pred (lyskom-filter-get-predicate (car pattern)))
+                  (type (and pred (lyskom-filter-get-datatype 
+                                   (filter-predicate->datatype pred))))
+                  (print-function
+                   (and type (filter-datatype->print-function type))))
+             (if (and (eq (filter-datatype->name type) 'negation)
+                      (null (lyskom-filter-predicate-comment pattern))
+                      (eq 1 (length (lyskom-filter-predicate-data pattern))))
+                 (lyskom-filter-edit-create-tree-data (car (lyskom-filter-predicate-data pattern))
+                                               (not negated))
+               (let ((string 
+                      (cond ((filter-datatype->is-function type)
+                             (if print-function
+                                 (funcall print-function pattern negated)
+                               (format "%S" (car pattern))))
+                            (t (lyskom-format "%#1S %#2s"
+                                              (car pattern)
+                                              (if print-function
+                                                  (funcall print-function
+                                                           pattern
+                                                           negated)
+                                                ""))))))
+                 (when (lyskom-filter-predicate-comment pattern)
+                   (setq string
+                         (concat string "\""
+                                 (lyskom-filter-predicate-comment pattern)
+                                 "\"")))
+
+               (list
+                ;; String representation
+                string
+                ;; Attributes
+                (unless (filter-datatype->is-function type)
+                  (list 'leaf t))
+                ;; Data
+                (vector negated
+                        (car pattern)
+                        (lyskom-filter-predicate-comment pattern)
+                        (unless (filter-datatype->is-function type)
+                          (lyskom-filter-predicate-data pattern)))
+                ;; Subtrees
+                (if (filter-datatype->is-function type)
+                    (mapcar (lambda (x) 
+                              (lyskom-filter-edit-create-tree-data x))
+                            (lyskom-filter-predicate-data pattern))
+                  nil))))))))
+
+(defun lyskom-filter-edit-extract-tree-data (tree)
+  "Extract a filter pattern from the tree TREE."
+  (lyskom-filter-edit-transform-extracted-data (tree-edit-collect-data tree)))
+
+(defun lyskom-filter-edit-transform-extracted-data (pattern)
+  "Create a filter pattern from data in PATTERN collected from a tree."
+  (cond ((null pattern) nil)
+        (t (let* ((node (if (vectorp pattern) pattern (car pattern)))
+                  (negated (aref node 0))
+                  (pred (aref node 1))
+                  (comment (aref node 2))
+                  (args (aref node 3))
+                  (type (lyskom-filter-get-datatype 
+                         (filter-predicate->datatype
+                          (lyskom-filter-get-predicate pred))))
+                  (form
+                   `(,pred ,comment ,@(if (filter-datatype->is-function type)
+                                          (mapcar 'lyskom-filter-edit-transform-extracted-data
+                                                  (cdr pattern))
+                                        args))))
+             (if negated
+                 `(not nil ,form)
+               form)))))
+
+
+
+;;; ============================================================
+;;; Drawing entries in the filter editor
+
+(defun lyskom-filter-edit-draw-header (entry)
+  "Insert the header of filter ENTRY at point."
+    (insert (format "-- %s --" (or (filter-edit-entry->name entry)
+                                   "Unnamed filter")))
+    (if (filter-edit-entry->collapsed entry)
+        (insert " [...]\n")
+      (insert "\n")
+      (insert (lyskom-format "Filter type:  %#1s\n" 
+                             (filter-edit-entry->action entry)))
+      (insert (lyskom-format "Active until: %#1s\n"
+                             (if (filter-edit-entry->permanent entry)
+                                 "There's ice-skating in hell"
+                               "End of current session"))))
+    (set-filter-edit-entry->header-end entry (point-marker))
+    (set-marker-insertion-type (filter-edit-entry->header-end entry) nil))
+
+
+(defun lyskom-filter-edit-draw-entry (entry)
+  "Insert text representation of ENTRY at point in the current buffer"
+  (let ((start (point-marker)))
+    (set-marker-insertion-type start nil)
+    (lyskom-filter-edit-draw-header entry)
+    (unless (filter-edit-entry->collapsed entry)
+      (unless (filter-edit-entry->tree entry)
+        (set-filter-edit-entry->tree  
+         entry
+         (tree-edit-compile-tree 
+          (lyskom-filter-edit-create-tree-data
+           (filter-edit-entry->pattern entry)))))
+      (tree-edit-draw (filter-edit-entry->tree entry))
+      (insert "----------------------------------------\n"))
+    (set-filter-edit-entry->end entry (point-marker))
+    (set-filter-edit-entry->start entry start)
+    (set-marker-insertion-type (filter-edit-entry->end entry) t)))
+
+(defun lyskom-filter-edit-delete-entry (entry)
+  (save-excursion
+    (delete-region (filter-edit-entry->start entry)
+                   (filter-edit-entry->end entry))
+    (set-filter-edit-entry->start nil)
+    (set-filter-edit-entry->end nil))
+
+(defun lyskom-filter-edit-redraw-header (entry)
+  (save-excursion
+    (let ((end (filter-edit-entry->header-end entry)))
+      (goto-char (filter-edit-entry->start entry))
+      (lyskom-filter-edit-draw-header entry)
+      (delete-region (point) end))
+
+
+;;; ============================================================
+;;; Utility functions
+
+(defun lyskom-filter-edit-all-entries ()
+  "Return a list of all filter edit entries in the current buffer"
+  lyskom-filter-edit-entry-list))
+
+(defun lyskom-filter-edit-set-entries (entries)
+  "Set the list of filter edit entries in buffer to ENTRIES.
+Do not redraw anything"
+  (setq lyskom-filter-edit-entry-list entries))
+
+(defun lyskom-filter-edit-entry-at (pos)
+  "Return the filter entry at POS"
+  (lyskom-traverse entry (lyskom-filter-edit-all-entries)
+    (cond ((and (<= (filter-edit-entry->start entry) pos)
+                (>= (filter-edit-entry->end entry)) pos)
+           (lyskom-traverse-break entry))
+          ((<= (filter-edit-entry->start entry) pos)
+           (lyskom-traverse-break nil)))))
+
+(defun lyskom-filter-edit-entry-position (entry)
+  "Reuturn the numeric position of filter edit entry ENTRY."
+  (- (length (lyskom-filter-edit-all-entries))
+     (length (memq entry (lyskom-filter-edit-all-entries)))))
+
+(defun lyskom-filter-edit-entry-in-header (pos entry)
+  "Return non-nil if POS is in the header area of ENTRY."
+  (and (>= pos (filter-edit-entry->start entry))
+       (< pos (filter-edit-entry->header-end entry))))
+
+(defun lyskom-filter-edit-entry-mode (entry to)
+  "Move filter entry ENTRY to before entry TO.
+If TO is nil, move to end of list."
+  (lyskom-filter-edit-delete-entry entry)
+  (if to
+      (goto-char (filter-edit-entry->start to))
+    (goto-char (point-max)))
+  (lyskom-filter-edit-draw-entry entry)
+  (lyskom-filter-edit-set-entries 
+   (lyskom-move-in-list entry 
+                        (lyskom-filter-edit-all-entries)
+                        to)
+
+
+;;; ============================================================
+;;; Interactive commands
+
+(defun lyskom-filter-edit-collapse-entry ()
+  "Collapse both filters and lines"
+  )
+
+(defun lyskom-filter-edit-expand-entry ()
+  "Collapse both filters and lines"
+  )
+
+(defun lyskom-filter-edit-kill ()
+  "Kill both filters and lines in trees"
+  )
+
+(defun lyskom-filter-edit-yank ()
+  "Yank both filters and lines in trees"
+  )
+
+(defun lyskom-filter-edit-move-up (arg)
+  "Move filters and lines up"
+  (interactive "p")
+  )
+
+(defun lyskom-filter-edit-move-down (arg)
+  "Move filters and lines down"
+  (interactive "p")
+  )
+
+(defun lyskom-filter-edit-previous-line (arg)
+  "Move cursor up ARG lines"
+  (interactive "p")
+  )
+
+(defun lyskom-filter-edit-next-line (arg)
+  "Move cursor down ARG lines"
+  (interactive "p")
+  )
+
+(defun lyskom-filter-edit-set-action ()
+  )
+
+(defun lyskom-filter-edit-set-permanent ()
+  )
+
+(defun lyskom-filter-edit-set-name ()
+  )
+
+(defun lyskom-filter-edit-set-predicate-comment ()
+  )
+
+(defun lyskom-filter-edit-negate-predicate ()
+  )
+
+(defun lyskom-filter-edit-add-predicate ()
+  )
+
+(defun lyskom-filter-edit-save-and-quit ()
+  )
+
+(defun lyskom-filter-edit-save ()
+  )
+
+(defun lyskom-filter-edit-quit ()
+  )
+
+
+
+;;; Local Variables:
+;;; mode: lisp-interaction
+
+(setq foo (lyskom-filter-edit-create-tree-data
+ '(and nil
+       (or nil
+           (recipient nil "Test")
+           (recipient nil "Tset"))
+       (not nil
+            (or nil
+                (subject nil "Foo")
+                (and nil
+                     (text nil "Fjuk")
+                     (recipient nil "Fjuk"))))
+       (not nil (author-re nil "[Dd]x")))))
+
+(lyskom-filter-edit-extract-tree-data tmp)
+

src/filter-new.el

+;;;;; -*-coding: iso-8859-1;-*-
+;;;;;
+;;;;; $Id$
+;;;;; Copyright (C) 2001  Lysator Academic Computer Association.
+;;;;;
+;;;;; This file is part of the LysKOM server.
+;;;;; 
+;;;;; LysKOM is free software; you can redistribute it and/or modify it
+;;;;; under the terms of the GNU General Public License as published by 
+;;;;; the Free Software Foundation; either version 2, or (at your option) 
+;;;;; any later version.
+;;;;; 
+;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
+;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;;;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;;;;; for more details.
+;;;;; 
+;;;;; You should have received a copy of the GNU General Public License
+;;;;; along with LysKOM; see the file COPYING.  If not, write to
+;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
+;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+;;;;; MA 02139, USA.
+;;;;;
+;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
+;;;;;
+;;;; ================================================================
+;;;; ================================================================
+;;;;
+;;;; File: filter-new.el
+;;;;
+;;;; New-style extensible filters.
+;;;;
+
+
+(setq lyskom-clientversion-long 
+      (concat lyskom-clientversion-long
+	      "$Id$\n"))
+
+;;; ================================================================
+;;; Sections
+;;;
+;;; Filter compilation
+;;;     Compilation of filters
+;;;
+;;; Filter predicates
+;;;     Functions defining what can be included in filters
+;;;
+;;; Filters
+;;;     Functions pertaining to running and evaluating filters.
+
+
+
+;;; ================================================================
+;;; Filter compilation
+
+(defvar lyskom-filter-compile-need-data)
+
+(defun lyskom-filter-compile (pattern)
+  (let* ((lyskom-filter-compile-need-data nil)
+         (result (lyskom-filter-compile-internal pattern))
+         (bindings
+          (mapcar (lambda (sym)
+                          `(,sym (lyskom-filter-get-text-data ',sym)))
+                  (lyskom-filter-expand-required-data lyskom-filter-compile-need-data))))
+    `(lambda () (let ,bindings ,result))))
+
+(defun lyskom-filter-compile-internal (pattern)
+  (let* ((key (car pattern))
+         (data (cdr (cdr pattern)))
+         (predicate (lyskom-filter-get-predicate key))
+         (datatype (and predicate (lyskom-filter-get-datatype
+                                   (filter-predicate->datatype predicate)))))
+    (when (filter-datatype->data-predicate datatype)
+      (apply (filter-datatype->data-predicate datatype) predicate data))
+    (setq lyskom-filter-compile-need-data
+          (append (filter-predicate->prerequisite-data predicate)
+                  lyskom-filter-compile-need-data))
+    (apply (filter-datatype->compile-function datatype)
+           (if (filter-predicate->compile-args predicate)
+               (append (filter-predicate->compile-args predicate)
+                       data)
+             data))))
+
+(defun lyskom-filter-compile-list (pattern)
+  (let ((result nil))
+    (while pattern
+      (setq result (cons (lyskom-filter-compile-internal (car pattern)) result))
+      (setq pattern (cdr pattern)))
+    (nreverse result)))
+
+(defun lyskom-filter-check-one-arg (check predicate args)
+  (unless (= 1 (length args))
+    (signal 'wrong-number-of-arguments 
+            (list (filter-predicate->name predicate)
+                  (length args))))
+  (unless (funcall check (car args))
+    (signal 'wrong-type-argument (list check (car args)))))
+
+(defun lyskom-filter-check-string (predicate &rest args)
+  (lyskom-filter-check-one-arg 'stringp predicate args))
+
+(defun lyskom-filter-check-regexp (predicate &rest args)
+  (lyskom-filter-check-one-arg 'regexpp predicate args))
+
+(defun lyskom-filter-check-integer (predicate &rest args)
+  (lyskom-filter-check-one-arg 'integerp predicate args))
+
+(defun lyskom-filter-compile-conjunction (&rest pattern)
+  (cons 'and (lyskom-filter-compile-list pattern)))
+
+(defun lyskom-filter-compile-disjunction (&rest pattern)
+  (cons 'or (lyskom-filter-compile-list pattern)))
+
+(defun lyskom-filter-compile-negation (&rest pattern)
+  (if (> 1 (length pattern))
+      (cons 'not (list (cons 'or (lyskom-filter-compile-list pattern))))
+    (cons 'not (lyskom-filter-compile-list pattern))))
+
+(defun lyskom-filter-compile-string-check (accessor arg)
+  `(string-match ,(regexp-quote arg) ,accessor))
+
+(defun lyskom-filter-compile-regexp-check (accessor arg)
+  `(string-match ,arg ,accessor))
+
+(defun lyskom-filter-compile-conf-no-check (accessor arg)
+  `(= ,accessor ,arg))
+
+(defun lyskom-filter-compile-string-list-check (list-source accessor arg)
+  `(lyskom-filter-is-member string-match
+                            ,(regexp-quote arg)
+                            ,list-source
+                            ,accessor))
+
+(defun lyskom-filter-compile-regexp-list-check (list-source accessor arg)
+  `(lyskom-filter-is-member string-match
+                            ,arg
+                            ,list-source
+                            ,accessor))
+
+(defun lyskom-filter-compile-conf-no-list-check (list-source accessor arg)
+  `(lyskom-filter-is-member =
+                            ,arg
+                            ,list-source
+                            ,accessor))
+
+
+;; (fset 'foo  (lyskom-filter-compile
+;;   '(and "" 
+;;         (author nil "David")
+;;         (recipient nil "Jim")
+;;         (subject nil "Foo"))))
+;; 
+;; (byte-compile 'foo)
+
+;; (lyskom-filter-compile 
+;;  '(and (or (recipient = "Test")
+;;            (recipient = "Tset"))
+;;        (not (or (subject = "Foo")
+;;                 (and (text = "Fjuk")
+;;                      (recipient = "Fjuk"))))
+;;        (not (author-no = 119))))
+
+
+
+
+
+
+;;; ================================================================
+;;; Filter predicates
+;;;
+
+(defvar lyskom-filter-datatypes nil)
+(defvar lyskom-filter-predicates nil)
+
+(def-komtype filter-datatype 
+  name
+  compile-function
+  read-function
+  print-function
+  data-predicate
+  is-function
+  )
+
+(def-komtype filter-predicate
+  name
+  datatype
+  prerequisite-data
+  compile-args
+  read-function-args
+  print-function
+  )
+
+(defmacro define-lyskom-filter-datatype (name &rest args)
+  `(setq lyskom-filter-datatypes
+         (cons (cons ',name
+                     (lyskom-create-filter-datatype
+                      ',name
+                      ,(plist-get args :compile-function)
+                      ,(plist-get args :read-function)
+                      ,(plist-get args :print-function)
+                      ,(plist-get args :data-predicate)
+                      ,(plist-get args :is-function)
+                      ))
+               lyskom-filter-datatypes)))
+
+(defmacro define-lyskom-filter-predicate (name &rest args)
+  `(setq lyskom-filter-predicates
+         (cons (cons ',name (lyskom-create-filter-predicate
+                             ',name
+                             ,(plist-get args :type)
+                             ,(plist-get args :data)
+                             ,(plist-get args :compile-args)
+                             ,(plist-get args :read-function-args)
+                             ,(plist-get args :print-function)
+                             ))
+               lyskom-filter-predicates)))
+
+(defun lyskom-filter-get-predicate (name)
+  "Return the filter predicate NAME."
+  (cdr (assq name lyskom-filter-predicates)))
+
+(defun lyskom-filter-get-datatype (name)
+  "Return the filter datatype NAME."
+  (cdr (assq name lyskom-filter-datatypes)))
+
+
+(define-lyskom-filter-datatype 
+  string
+  :compile-function 'lyskom-filter-compile-string-check
+  :read-function 'lyskom-read-from-minibuffer
+  :print-function 'lyskom-filter-edit-print-string
+  :data-predicate 'lyskom-filter-check-string
+  )
+
+(define-lyskom-filter-datatype
+  string-list
+  :compile-function 'lyskom-filter-compile-string-list-check
+  :read-function 'lyskom-read-from-minibuffer
+  :print-function 'lyskom-filter-edit-print-string
+  :data-predicate 'lyskom-filter-check-string
+  )
+
+(define-lyskom-filter-datatype
+  regexp
+  :compile-function 'lyskom-filter-compile-regexp-check
+  :read-function 'lyskom-filter-edit-read-regexp
+  :print-function 'lyskom-filter-edit-print-regexp
+  :data-predicate 'lyskom-filter-check-regexp
+  )
+
+(define-lyskom-filter-datatype
+  regexp-list
+  :compile-function 'lyskom-filter-compile-regexp-list-check
+  :read-function 'lyskom-filter-edit-read-regexp
+  :print-function 'lyskom-filter-edit-print-regexp
+  :data-predicate 'lyskom-filter-check-regexp
+  )
+
+
+
+(define-lyskom-filter-datatype
+  conf-no
+  :compile-function 'lyskom-filter-compile-conf-no-check
+  :read-function 'lyskom-read-conf-no
+  :print-function 'lyskom-filter-edit-print-conf-no
+  :data-predicate 'lyskom-filter-check-integer
+  )
+
+(define-lyskom-filter-datatype
+  conf-no-list
+  :compile-function 'lyskom-filter-compile-conf-no-list-check
+  :read-function 'lyskom-read-conf-no
+  :print-function 'lyskom-filter-edit-print-conf-no
+  :data-predicate 'lyskom-filter-check-integer
+  )
+
+(define-lyskom-filter-datatype
+  conjunction
+  :compile-function 'lyskom-filter-compile-conjunction
+  :print-function 'lyskom-filter-edit-print-builtin
+  :is-function t
+  )
+
+(define-lyskom-filter-datatype
+  disjunction