[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/rt-liberation c81f084 8/8: Merge branch 'master' into e
|
From: |
Yoni Rabkin |
|
Subject: |
[elpa] externals/rt-liberation c81f084 8/8: Merge branch 'master' into externals/rt-liberation |
|
Date: |
Fri, 5 Mar 2021 14:30:34 -0500 (EST) |
branch: externals/rt-liberation
commit c81f084d660848d5bf06a108e45815c5ae96727a
Merge: 45d1798 cfc0a7c
Author: Yoni Rabkin <yoni@rabkins.net>
Commit: Yoni Rabkin <yoni@rabkins.net>
Merge branch 'master' into externals/rt-liberation
---
NEWS | 7 ++
doc/developer-release.txt | 13 +-
rt-liberation-compiler.el | 186 +++++++++++++++++++++++++++++
rt-liberation-rest.el | 154 +++++++++++++++++++++++-
rt-liberation.el | 295 +---------------------------------------------
5 files changed, 359 insertions(+), 296 deletions(-)
diff --git a/NEWS b/NEWS
index 85900a0..3d70407 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,10 @@
+New in version 2.03
+
+ * Bug fix: incorrect display of certain dates in the viewer.
+
+ * Major reorganization of the code to help modularization.
+
+
New in version 2.02
* The new viewer now displays meaningful descriptors in
diff --git a/doc/developer-release.txt b/doc/developer-release.txt
index ee5945d..8dd9677 100644
--- a/doc/developer-release.txt
+++ b/doc/developer-release.txt
@@ -30,11 +30,16 @@ Push these updates to the git repo.
Tag the release with the ELPA version number, then push that tag to
the VCS:
- $ git tag -a 2.00 -m "2.00"
+ $ git tag -a 2.2 -m "2.2"
- $ git push --tags origin "2.00"
+ $ git push --tags origin "2.2"
* ELPA
-Push the changes to externals/rt-liberation on elpa.git with:
+Merge the changes into the local externals/rt-liberation (git will
+complain) and then push the changes to externals/rt-liberation on
+elpa.git with:
- $ git push elpa elpa:refs/heads/externals/rt-liberation
+ $ git push
+
+...as long as externals/rt-liberation has the right remote and merge
+setup.
diff --git a/rt-liberation-compiler.el b/rt-liberation-compiler.el
new file mode 100644
index 0000000..323903d
--- /dev/null
+++ b/rt-liberation-compiler.el
@@ -0,0 +1,186 @@
+;;; rt-liberation-compiler.el --- Emacs interface to RT -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Yoni Rabkin <yrk@gnu.org>
+;; Authors: Aaron S. Hawley <aaron.s.hawley@gmail.com>, John Sullivan
<johnsu01@wjsullivan.net>
+;; Maintainer: Yoni Rabkin <yrk@gnu.org>
+;; 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)
+
+
+;;; ------------------------------------------------------------------
+;;; variables and constants
+;;; ------------------------------------------------------------------
+(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-rest.el b/rt-liberation-rest.el
index a7eb076..c6890dd 100644
--- a/rt-liberation-rest.el
+++ b/rt-liberation-rest.el
@@ -28,7 +28,6 @@
;; dependency on a local copy of the RT CLI.
;;; Code:
-
(require 'url)
(require 'url-util)
(require 'auth-source)
@@ -58,6 +57,25 @@
(defvar rt-liber-rest-verbose-p t
"If non-nil, be verbose about what's happening.")
+(defvar rt-liber-ticket-old-threshold 30
+ "Age in days before a ticket is considered old.")
+
+(defvar rt-liber-field-dictionary
+ '((owner . "Owner")
+ (queue . "Queue")
+ (status . "Status")
+ (priority . "Priority"))
+ "Mapping between field symbols and RT field strings.
+The field symbols provide the programmer with a consistent way of
+referring to RT fields.")
+
+(defvar rt-liber-debug-log-enable nil
+ "If t then enable logging of communication to a buffer.
+Careful! This might create a sizable buffer.")
+
+(defvar rt-liber-debug-log-buffer-name "*rt-liber debug log*"
+ "Name of debug log buffer.")
+
;;; ------------------------------------------------------------------
;;; functions
@@ -259,6 +277,140 @@
(message "edit command ended at %s" (current-time-string)))
+;;; --------------------------------------------------------
+;;; Debug log
+;;; --------------------------------------------------------
+(defun rt-liber-debug-log-write (str)
+ "Write STR to debug log."
+ (when (not (stringp str))
+ (error "must be a string"))
+ (with-current-buffer (get-buffer-create
+ rt-liber-debug-log-buffer-name)
+ (goto-char (point-max))
+ (insert str)))
+
+
+;;; --------------------------------------------------------
+;;; Parse Answer
+;;; --------------------------------------------------------
+(defun rt-liber-parse-answer (answer-string parser-f)
+ "Operate on ANSWER-STRING with PARSER-F."
+ (with-temp-buffer
+ (insert answer-string)
+ (goto-char (point-min))
+ (when rt-liber-debug-log-enable
+ (rt-liber-debug-log-write (buffer-substring (point-min)
+ (point-max))))
+ (funcall parser-f)))
+
+
+;;; --------------------------------------------------------
+;;; Ticket list retriever
+;;; --------------------------------------------------------
+(put 'rt-liber-no-result-from-query-error
+ 'error-conditions
+ '(error rt-liber-errors rt-liber-no-result-from-query-error))
+
+(put 'rt-liber-no-result-from-query-error
+ 'error-message
+ "No results from query")
+
+(defun rt-liber-ticket-base-retriever-parser-f ()
+ "Parser function for ticket list."
+ (let (ticketbase-list ticketbase (continue t))
+ (while (save-excursion
+ (re-search-forward "^id:" (point-max) t))
+ (while (and continue
+ (re-search-forward
+ "^\\(\\([.{} #[:alpha:]]+\\): \\(.*\\)\\)$\\|^--$"
+ (point-max) t))
+ (if (string= (match-string-no-properties 0) "--")
+ (setq continue nil)
+ (push (cons (match-string-no-properties 2)
+ (match-string-no-properties 3))
+ ticketbase)))
+ (push (copy-sequence ticketbase) ticketbase-list)
+ (setq ticketbase nil
+ continue t))
+ ticketbase-list))
+
+(defun rt-liber-rest-ticketsql-runner-parser-f ()
+ "Parser function for a textual list of tickets."
+ (let (idsub-list)
+ (rt-liber-rest-parse-http-header)
+ (while (re-search-forward "ticket/\\([0-9].+\\)" (point-max) t)
+ (push (list (match-string-no-properties 1)
+ ".")
+ idsub-list))
+ idsub-list))
+
+(defun rt-liber-rest-run-ls-query (query)
+ "Run an \"ls\" type query against the server with QUERY."
+ (rt-liber-parse-answer
+ (rt-liber-rest-query-runner "ls" query)
+ 'rt-liber-rest-ticketsql-runner-parser-f))
+
+(defun rt-liber-rest-run-show-base-query (idsublist)
+ "Run \"show\" type query against the server with IDSUBLIST."
+ (rt-liber-parse-answer
+ (rt-liber-rest-show-query-runner idsublist)
+ #'rt-liber-ticket-base-retriever-parser-f))
+
+(defun rt-liber-rest-run-ticket-history-base-query (ticket-id)
+ "Run history query against server for TICKET-ID."
+ (rt-liber-parse-answer
+ (rt-liber-rest-query-runner "history" ticket-id)
+ #'(lambda ()
+ (rt-liber-rest-parse-http-header)
+ (buffer-substring (point) (point-max)))))
+
+(defun rt-liber-rest-command-set (id field status)
+ "Set ticket ID status to be STATUS."
+ (rt-liber-parse-answer
+ (rt-liber-rest-edit-runner id field status)
+ 'rt-liber-command-runner-parser-f))
+
+
+;;; --------------------------------------------------------
+;;; Ticket utilities
+;;; --------------------------------------------------------
+(defun rt-liber-ticket-days-old (ticket-alist)
+ "Return the age of the ticket in positive days."
+ (days-between (format-time-string "%Y-%m-%dT%T%z" (current-time))
+ (cdr (assoc "Created" ticket-alist))))
+
+(defun rt-liber-ticket-old-p (ticket-alist)
+ (<= rt-liber-ticket-old-threshold
+ (rt-liber-ticket-days-old ticket-alist)))
+
+(defun rt-liber-ticket-id-only (ticket-alist)
+ "Return numerical portion of ticket number from TICKET-ALIST."
+ (if ticket-alist
+ (substring (cdr (assoc "id" ticket-alist)) 7)
+ nil))
+
+(defun rt-liber-ticket-priority-only (ticket-alist)
+ "Return an integer value priority or NIL."
+ (if ticket-alist
+ (let ((p-str (cdr (assoc "Priority" ticket-alist))))
+ (if p-str
+ (string-to-number p-str)
+ nil))
+ nil))
+
+(defun rt-liber-ticket-owner-only (ticket-alist)
+ "Return the string value of the ticket owner."
+ (when (not ticket-alist)
+ (error "null ticket-alist"))
+ (cdr (assoc (rt-liber-get-field-string 'owner)
+ ticket-alist)))
+
+(defun rt-liber-get-field-string (field-symbol)
+ (when (not field-symbol)
+ (error "null field symbol"))
+ (cdr (assoc field-symbol rt-liber-field-dictionary)))
+
+
(provide 'rt-liberation-rest)
;;; rt-liberation-rest.el ends here.
diff --git a/rt-liberation.el b/rt-liberation.el
index a2b116a..63157ff 100644
--- a/rt-liberation.el
+++ b/rt-liberation.el
@@ -5,7 +5,7 @@
;; Author: Yoni Rabkin <yrk@gnu.org>
;; Authors: Aaron S. Hawley <aaron.s.hawley@gmail.com>, John Sullivan
<johnsu01@wjsullivan.net>
;; Maintainer: Yoni Rabkin <yrk@gnu.org>
-;; Version: 2.2
+;; Version: 2.3
;; Keywords: rt, tickets
;; Package-Type: multi
;; url: http://www.nongnu.org/rtliber/
@@ -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.")
@@ -142,9 +116,6 @@ function returns a truth value.")
'rt-liber-ticketlist-browser-redraw-f
"Default ticket redraw function.")
-(defvar rt-liber-ticket-old-threshold 30
- "Age in days before a ticket is considered old.")
-
(defvar rt-liber-jump-to-latest nil
"jump to the latest correspondence when viewing a ticket.")
@@ -196,15 +167,6 @@ of referring to certain commands. The command strings are
the
specific strings which would produce the desired effect in the
server.")
-(defvar rt-liber-field-dictionary
- '((owner . "Owner")
- (queue . "Queue")
- (status . "Status")
- (priority . "Priority"))
- "Mapping between field symbols and RT field strings.
-The field symbols provide the programmer with a consistent way of
-referring to RT fields.")
-
(defvar rt-liber-status-dictionary
'((deleted . "deleted")
(resolved . "resolved")
@@ -215,13 +177,6 @@ The status symbols provide the programmer with a
consistent way
of referring to certain statuses. The status strings are the
server specific strings.")
-(defvar rt-liber-debug-log-enable nil
- "If t then enable logging of communication to a buffer.
-Careful! This might create a sizable buffer.")
-
-(defvar rt-liber-debug-log-buffer-name "*rt-liber debug log*"
- "Name of debug log buffer.")
-
(defvar rt-liber-ticket-local nil
"Buffer local storage for a ticket.
This variable is made buffer local for the ticket history")
@@ -254,248 +209,6 @@ This variable is made buffer local for the ticket
history")
;;; --------------------------------------------------------
-;;; Debug log
-;;; --------------------------------------------------------
-(defun rt-liber-debug-log-write (str)
- "Write STR to debug log."
- (when (not (stringp str))
- (error "must be a string"))
- (with-current-buffer (get-buffer-create
- rt-liber-debug-log-buffer-name)
- (goto-char (point-max))
- (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
-;;; --------------------------------------------------------
-(defun rt-liber-parse-answer (answer-string parser-f)
- "Operate on ANSWER-STRING with PARSER-F."
- (with-temp-buffer
- (insert answer-string)
- (goto-char (point-min))
- (when rt-liber-debug-log-enable
- (rt-liber-debug-log-write (buffer-substring (point-min)
- (point-max))))
- (funcall parser-f)))
-
-
-;;; --------------------------------------------------------
-;;; Ticket list retriever
-;;; --------------------------------------------------------
-(put 'rt-liber-no-result-from-query-error
- 'error-conditions
- '(error rt-liber-errors rt-liber-no-result-from-query-error))
-
-(put 'rt-liber-no-result-from-query-error
- 'error-message
- "No results from query")
-
-(defun rt-liber-ticket-base-retriever-parser-f ()
- "Parser function for ticket list."
- (let (ticketbase-list ticketbase (continue t))
- (while (save-excursion
- (re-search-forward "^id:" (point-max) t))
- (while (and continue
- (re-search-forward
- "^\\(\\([.{} #[:alpha:]]+\\): \\(.*\\)\\)$\\|^--$"
- (point-max) t))
- (if (string= (match-string-no-properties 0) "--")
- (setq continue nil)
- (push (cons (match-string-no-properties 2)
- (match-string-no-properties 3))
- ticketbase)))
- (push (copy-sequence ticketbase) ticketbase-list)
- (setq ticketbase nil
- continue t))
- ticketbase-list))
-
-(defun rt-liber-rest-ticketsql-runner-parser-f ()
- "Parser function for a textual list of tickets."
- (let (idsub-list)
- (rt-liber-rest-parse-http-header)
- (while (re-search-forward "ticket/\\([0-9].+\\)" (point-max) t)
- (push (list (match-string-no-properties 1)
- ".")
- idsub-list))
- idsub-list))
-
-(defun rt-liber-rest-run-ls-query (query)
- "Run an \"ls\" type query against the server with QUERY."
- (rt-liber-parse-answer
- (rt-liber-rest-query-runner "ls" query)
- 'rt-liber-rest-ticketsql-runner-parser-f))
-
-(defun rt-liber-rest-run-show-base-query (idsublist)
- "Run \"show\" type query against the server with IDSUBLIST."
- (rt-liber-parse-answer
- (rt-liber-rest-show-query-runner idsublist)
- #'rt-liber-ticket-base-retriever-parser-f))
-
-(defun rt-liber-rest-run-ticket-history-base-query (ticket-id)
- "Run history query against server for TICKET-ID."
- (rt-liber-parse-answer
- (rt-liber-rest-query-runner "history" ticket-id)
- #'(lambda ()
- (rt-liber-rest-parse-http-header)
- (buffer-substring (point) (point-max)))))
-
-(defun rt-liber-rest-command-set (id field status)
- "Set ticket ID status to be STATUS."
- (rt-liber-parse-answer
- (rt-liber-rest-edit-runner id field status)
- 'rt-liber-command-runner-parser-f))
-
-
-;;; --------------------------------------------------------
-;;; Ticket utilities
-;;; --------------------------------------------------------
-(defun rt-liber-ticket-days-old (ticket-alist)
- "Return the age of the ticket in positive days."
- (days-between (format-time-string "%Y-%m-%dT%T%z" (current-time))
- (cdr (assoc "Created" ticket-alist))))
-
-(defun rt-liber-ticket-old-p (ticket-alist)
- (<= rt-liber-ticket-old-threshold
- (rt-liber-ticket-days-old ticket-alist)))
-
-(defun rt-liber-ticket-id-only (ticket-alist)
- "Return numerical portion of ticket number from TICKET-ALIST."
- (if ticket-alist
- (substring (cdr (assoc "id" ticket-alist)) 7)
- nil))
-
-(defun rt-liber-ticket-priority-only (ticket-alist)
- "Return an integer value priority or NIL."
- (if ticket-alist
- (let ((p-str (cdr (assoc "Priority" ticket-alist))))
- (if p-str
- (string-to-number p-str)
- nil))
- nil))
-
-(defun rt-liber-ticket-owner-only (ticket-alist)
- "Return the string value of the ticket owner."
- (when (not ticket-alist)
- (error "null ticket-alist"))
- (cdr (assoc (rt-liber-get-field-string 'owner)
- ticket-alist)))
-
-(defun rt-liber-get-field-string (field-symbol)
- (when (not field-symbol)
- (error "null field symbol"))
- (cdr (assoc field-symbol rt-liber-field-dictionary)))
-
-
-;;; --------------------------------------------------------
;;; Ticket browser
;;; --------------------------------------------------------
;; accept a ticket-alist object and return an alist mapping ticket
@@ -1263,12 +976,12 @@ ASSOC-BROWSER if non-nil should be a ticket browser."
((< 0 days-ago 7)
(format "%s day%s ago" days-ago
(rt-liber-viewer2-vernacular-plural days-ago)))
- ((< 7 days-ago 30)
+ ((<= 7 days-ago 30)
(let ((weeks (floor (/ days-ago 7.0))))
(format "%s week%s ago"
weeks
(rt-liber-viewer2-vernacular-plural weeks))))
- ((< 30 days-ago 365)
+ ((<= 30 days-ago 365)
(let ((months (floor (/ days-ago 30.0))))
(format "%s month%s ago"
months
- [elpa] externals/rt-liberation updated (45d1798 -> c81f084), Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation abf4625 4/8: * rt-liberation-compiler.el: split out compiler code, Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation 78b9cfb 2/8: * doc/developer-release.txt:, Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation 000c356 3/8: * rt-liberation.el: bug fix, Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation cfc0a7c 7/8: * NEWS: give the people the news, Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation c81f084 8/8: Merge branch 'master' into externals/rt-liberation,
Yoni Rabkin <=
- [elpa] externals/rt-liberation 635951b 6/8: * rt-liberation.el: version bump, Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation 9a41670 5/8: * rt-liberation-rest.el: split code to here, Yoni Rabkin, 2021/03/05
- [elpa] externals/rt-liberation 6e16bf2 1/8: * doc/developer-release.txt:, Yoni Rabkin, 2021/03/05