Commit 86b3e380 authored by David Byers's avatar David Byers
Browse files

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.
parent 221419dd
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> 2001-04-25 David Byers <davby@ida.liu.se>
* async.el (lyskom-parse-async): Update name of conference in * async.el (lyskom-parse-async): Update name of conference in
......
;;;;; -*-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)
;;;;; -*-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
:compile-function 'lyskom-filter-compile-disjunction
:print-function 'lyskom-filter-edit-print-builtin
:is-function t
)
(define-lyskom-filter-datatype
negation
:print-function 'lyskom-filter-edit-print-builtin
:compile-function 'lyskom-filter-compile-negation