From abf4625d1785638d0ce6940818bb4fab3a82fcc3 Mon Sep 17 00:00:00 2001 From: Yoni Rabkin Date: Fri, 5 Mar 2021 12:40:50 -0500 Subject: * rt-liberation-compiler.el: split out compiler code --- rt-liberation-compiler.el | 183 ++++++++++++++++++++++++++++++++++++++++++++++ rt-liberation.el | 136 +--------------------------------- 2 files changed, 184 insertions(+), 135 deletions(-) create mode 100644 rt-liberation-compiler.el diff --git a/rt-liberation-compiler.el b/rt-liberation-compiler.el new file mode 100644 index 0000000..870d802 --- /dev/null +++ b/rt-liberation-compiler.el @@ -0,0 +1,183 @@ +;;; rt-liberation-compiler.el --- Emacs interface to RT -*- lexical-binding: t; -*- + +;; Copyright (C) 2008-2021 Free Software Foundation, Inc. + +;; Author: Yoni Rabkin +;; Authors: Aaron S. Hawley , John Sullivan +;; Maintainer: Yoni Rabkin +;; Keywords: rt, tickets +;; url: http://www.nongnu.org/rtliber/ + +;; This file is a part of rt-liberation. + +;; This program 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 3 of the +;; License, or (at your option) any later version. +;; +;; This program 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 this program; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + +;;; Installation and Use: +;; +;; Detailed instructions for installation and use can be found in the +;; rt-liberation manual, in the doc/ directory of the distribution. + +;;; History: +;; +;; Started near the end of 2008. + + +;;; Code: +(require 'cl-lib) + + +(defvar rt-liber-content-string "Content LIKE" + "String representation of \"content\" query tag.") + +(defvar rt-liber-subject-string "Subject LIKE" + "String representation of \"subject\" query tag.") + +(defvar rt-liber-email-address-string "Requestor.EmailAddress LIKE" + "String representation of \"Requestor.EmailAddress\" query tag.") + +(defvar rt-liber-content-not-string "Content NOT LIKE" + "String representation of \"content\" query tag.") + +(defvar rt-liber-subject-not-string "Subject NOT LIKE" + "String representation of \"subject\" query tag.") + +(defvar rt-liber-resolved-string "Resolved" + "String representation of \"resolved\" query tag.") + +(defvar rt-liber-lastupdated-string "LastUpdated" + "String representation of \"lastupdated\" query tag.") + +(defvar rt-liber-email-address-not-string "Requestor.EmailAddress NOT LIKE" + "String representation of \"Requestor.EmailAddress\" query tag.") + +(defvar rt-liber-created-string "Created" + "String representation of \"created\" query tag.") + + +;;; -------------------------------------------------------- +;;; TicketSQL compiler +;;; -------------------------------------------------------- +(eval-and-compile ;; for use in macro `rt-liber-compile-query' + (defun rt-liber-bool-p (sym) + "Return t if SYM is a boolean operator, otherwise nil." + (member sym '(and or))) + + (defun rt-liber-attrib-p (sym) + "Return t if SYM is a ticket attribute, otherwise nil." + (member sym '(id owner status subject content queue lastupdatedby + email-address))) + + (defun rt-liber-time-p (sym) + "Return t if SYM is a temporal attribute, otherwise nil." + (member sym '(created lastupdated resolved))) + + (defun rt-liber-negation-p (sym) + (member sym '(not))) + + (defun rt-liber-reduce (op seq) + "Reduce-OP with SEQ to a string of \"s0 op s1 op s2..\"." + (if seq + (cl-reduce + #'(lambda (a b) + (format "%s %s %s" a op b)) + seq) + "")) + + (defun rt-liber-make-interval (pred before after) + "Return a formatted TicketSQL interval. +PRED temporal attribute predicate. +BEFORE date before predicate. +AFTER date after predicate." + (when (string= before "") (setq before nil)) + (when (string= after "") (setq after nil)) + (concat + (if before (format "%s < '%s'" pred before) "") + (if (and before after) (format " AND ") "") + (if after (format "%s > '%s'" pred after) "")))) + +(defmacro rt-liber-compile-query (query &optional n) + "Compile sexp-based QUERY into TicketSQL." + (cond ((null query) `"") + ((stringp query) `,query) + ((rt-liber-bool-p query) `,(upcase (format "%s" query))) + ;; attribute (positive) + ((and (rt-liber-attrib-p query) + (not n)) + `,(cond ((equal query 'content) rt-liber-content-string) + ((equal query 'subject) rt-liber-subject-string) + ((equal query 'email-address) rt-liber-email-address-string) + (t (capitalize (format "%s =" query))))) + ;; attribute (negation) + ((and (rt-liber-attrib-p query) + n) + `,(cond ((equal query 'content) rt-liber-content-not-string) + ((equal query 'subject) rt-liber-subject-not-string) + ((equal query 'email-address) rt-liber-email-address-not-string) + (t (capitalize (format "%s !=" query))))) + ;; time + ((rt-liber-time-p query) + `,(cond ((equal query 'created) rt-liber-created-string) + ((equal query 'lastupdated) rt-liber-lastupdated-string) + ((equal query 'resolved) rt-liber-resolved-string))) + ((and (listp query) + (rt-liber-time-p (car query))) + `(rt-liber-make-interval + (rt-liber-compile-query ,(car query)) + (rt-liber-compile-query ,(cadr query)) + (rt-liber-compile-query ,(caddr query)))) + ;; function (known at compile time?) + ((and query + (listp query) + (not (rt-liber-bool-p (car query))) + (not (rt-liber-negation-p (car query))) + (functionp (car query))) + `(format "%s" ,query)) + ;; negation attribute pairs + ((and (listp query) + (rt-liber-negation-p (car query)) + (rt-liber-attrib-p (caadr query))) + `(format "%s '%s'" + (rt-liber-compile-query ,(caadr query) t) ; negate + (rt-liber-compile-query ,(cadadr query)))) + ;; attribute pairs + ((and (listp query) + (rt-liber-attrib-p (car query))) + `(format "%s '%s'" + (rt-liber-compile-query ,(car query)) + (rt-liber-compile-query ,(cadr query)))) + ;; splice boolean operators + ((and (listp query) + (rt-liber-bool-p (car query))) + `(rt-liber-reduce (rt-liber-compile-query ,(car query)) + (rt-liber-compile-query ,(cdr query)))) + ;; compound statements + ((and (listp query) + (not (cdr query))) + `(list (rt-liber-compile-query ,(car query)))) + ((listp query) + `(append + (list (rt-liber-compile-query ,(car query))) + (rt-liber-compile-query ,(cdr query)))) + ;; free variable + ((and query + (symbolp query)) + `(format "%s" ,query)) + (t (error "cannot compile query %s" query)))) + + +(provide 'rt-liberation-compiler) + +;;; rt-liberation-compiler.el ends here. diff --git a/rt-liberation.el b/rt-liberation.el index 04d9965..268b745 100644 --- a/rt-liberation.el +++ b/rt-liberation.el @@ -43,6 +43,7 @@ (require 'cl-lib) (require 'rt-liberation-rest) +(require 'rt-liberation-compiler) (declare-function rt-liber-get-ancillary-text "rt-liberation-storage.el") (declare-function rt-liber-ticket-marked-p "rt-liberation-multi.el") @@ -77,39 +78,12 @@ 'font-lock-comment-face))) "Expressions to font-lock for RT ticket viewer.") -(defvar rt-liber-created-string "Created" - "String representation of \"created\" query tag.") - (defvar rt-liber-resolved-string "Resolved" "String representation of \"resolved\" query tag.") (defvar rt-liber-base-url "" "Base url for ticket display.") -(defvar rt-liber-lastupdated-string "LastUpdated" - "String representation of \"lastupdated\" query tag.") - -(defvar rt-liber-resolved-string "Resolved" - "String representation of \"resolved\" query tag.") - -(defvar rt-liber-content-string "Content LIKE" - "String representation of \"content\" query tag.") - -(defvar rt-liber-subject-string "Subject LIKE" - "String representation of \"subject\" query tag.") - -(defvar rt-liber-email-address-string "Requestor.EmailAddress LIKE" - "String representation of \"Requestor.EmailAddress\" query tag.") - -(defvar rt-liber-content-not-string "Content NOT LIKE" - "String representation of \"content\" query tag.") - -(defvar rt-liber-subject-not-string "Subject NOT LIKE" - "String representation of \"subject\" query tag.") - -(defvar rt-liber-email-address-not-string "Requestor.EmailAddress NOT LIKE" - "String representation of \"Requestor.EmailAddress\" query tag.") - (defvar rt-liber-content-regexp "^Content:.*$" "Regular expression for section headers.") @@ -266,114 +240,6 @@ This variable is made buffer local for the ticket history") (insert str))) -;;; -------------------------------------------------------- -;;; TicketSQL compiler -;;; -------------------------------------------------------- -(eval-and-compile ;; for use in macro `rt-liber-compile-query' - (defun rt-liber-bool-p (sym) - "Return t if SYM is a boolean operator, otherwise nil." - (member sym '(and or))) - (defun rt-liber-attrib-p (sym) - "Return t if SYM is a ticket attribute, otherwise nil." - (member sym '(id owner status subject content queue lastupdatedby - email-address))) - (defun rt-liber-time-p (sym) - "Return t if SYM is a temporal attribute, otherwise nil." - (member sym '(created lastupdated resolved))) - (defun rt-liber-negation-p (sym) - (member sym '(not))) - - (defun rt-liber-reduce (op seq) - "Reduce-OP with SEQ to a string of \"s0 op s1 op s2..\"." - (if seq - (cl-reduce - #'(lambda (a b) - (format "%s %s %s" a op b)) - seq) - "")) - - (defun rt-liber-make-interval (pred before after) - "Return a formatted TicketSQL interval. -PRED temporal attribute predicate. -BEFORE date before predicate. -AFTER date after predicate." - (when (string= before "") (setq before nil)) - (when (string= after "") (setq after nil)) - (concat - (if before (format "%s < '%s'" pred before) "") - (if (and before after) (format " AND ") "") - (if after (format "%s > '%s'" pred after) "")))) - -(defmacro rt-liber-compile-query (query &optional n) - "Compile sexp-based QUERY into TicketSQL." - (cond ((null query) `"") - ((stringp query) `,query) - ((rt-liber-bool-p query) `,(upcase (format "%s" query))) - ;; attribute (positive) - ((and (rt-liber-attrib-p query) - (not n)) - `,(cond ((equal query 'content) rt-liber-content-string) - ((equal query 'subject) rt-liber-subject-string) - ((equal query 'email-address) rt-liber-email-address-string) - (t (capitalize (format "%s =" query))))) - ;; attribute (negation) - ((and (rt-liber-attrib-p query) - n) - `,(cond ((equal query 'content) rt-liber-content-not-string) - ((equal query 'subject) rt-liber-subject-not-string) - ((equal query 'email-address) rt-liber-email-address-not-string) - (t (capitalize (format "%s !=" query))))) - ;; time - ((rt-liber-time-p query) - `,(cond ((equal query 'created) rt-liber-created-string) - ((equal query 'lastupdated) rt-liber-lastupdated-string) - ((equal query 'resolved) rt-liber-resolved-string))) - ((and (listp query) - (rt-liber-time-p (car query))) - `(rt-liber-make-interval - (rt-liber-compile-query ,(car query)) - (rt-liber-compile-query ,(cadr query)) - (rt-liber-compile-query ,(caddr query)))) - ;; function (known at compile time?) - ((and query - (listp query) - (not (rt-liber-bool-p (car query))) - (not (rt-liber-negation-p (car query))) - (functionp (car query))) - `(format "%s" ,query)) - ;; negation attribute pairs - ((and (listp query) - (rt-liber-negation-p (car query)) - (rt-liber-attrib-p (caadr query))) - `(format "%s '%s'" - (rt-liber-compile-query ,(caadr query) t) ; negate - (rt-liber-compile-query ,(cadadr query)))) - ;; attribute pairs - ((and (listp query) - (rt-liber-attrib-p (car query))) - `(format "%s '%s'" - (rt-liber-compile-query ,(car query)) - (rt-liber-compile-query ,(cadr query)))) - ;; splice boolean operators - ((and (listp query) - (rt-liber-bool-p (car query))) - `(rt-liber-reduce (rt-liber-compile-query ,(car query)) - (rt-liber-compile-query ,(cdr query)))) - ;; compound statements - ((and (listp query) - (not (cdr query))) - `(list (rt-liber-compile-query ,(car query)))) - ((listp query) - `(append - (list (rt-liber-compile-query ,(car query))) - (rt-liber-compile-query ,(cdr query)))) - ;; free variable - ((and query - (symbolp query)) - `(format "%s" ,query)) - (t (error "cannot compile query %s" query)))) - - ;;; -------------------------------------------------------- ;;; Parse Answer ;;; -------------------------------------------------------- -- cgit v1.2.3