summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--rt-liberation-browser.el533
-rw-r--r--rt-liberation-report.el2
-rw-r--r--rt-liberation-rest.el85
-rw-r--r--rt-liberation-storage.el7
-rw-r--r--rt-liberation-update.el3
-rw-r--r--rt-liberation-viewer.el73
-rw-r--r--rt-liberation.el613
7 files changed, 670 insertions, 646 deletions
diff --git a/rt-liberation-browser.el b/rt-liberation-browser.el
new file mode 100644
index 0000000..7c2e5c5
--- /dev/null
+++ b/rt-liberation-browser.el
@@ -0,0 +1,533 @@
+;;; rt-liberation-browser.el --- Emacs interface to RT -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+;;
+;; Authors: Yoni Rabkin <yrk@gnu.org>
+;;
+;; 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.
+
+
+;;; Code:
+(require 'rt-liberation-rest)
+
+(declare-function rt-liber-get-ancillary-text "rt-liberation-storage.el")
+(declare-function rt-liber-display-ticket-history "rt-liberation-viewer.el" '(ticket-alist &optional assoc-browser))
+(declare-function rt-liber-viewer2-display-ticket-history "rt-liberation-viewer.el" '(ticket-alist &optional assoc-browser))
+
+(defvar rt-liber-base-url ""
+ "Base url for ticket display.")
+
+(defvar rt-liber-ticket-local nil
+ "Buffer local storage for a ticket.
+This variable is made buffer local for the ticket history")
+
+(defvar rt-liber-correspondence-regexp
+ "^Type: \\(EmailRecord\\|CommentEmailRecord\\|Correspond\\)"
+ "Regular expression for correspondence sections.")
+
+(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-custom-ticket-redraw-function
+ 'rt-liber-ticketlist-browser-redraw-f
+ "Default ticket redraw function.")
+
+(defvar rt-liber-anc-p nil
+ "Display ancillary data for tickets.")
+
+(defvar rt-liber-query nil
+ "Query structure (becomes ticket-browser buffer local).")
+
+(defvar rt-liber-ticket-list nil
+ "Ticket-list structure (becomes ticket-browser buffer local).")
+
+(defvar rt-liber-browser-buffer-name "*ticket-browser*"
+ "Name of ticket browser buffer.")
+
+(defvar rt-liber-browser-buffer nil
+ "Ticket browser buffer.")
+
+(defvar rt-liber-browser-default-sorting-function
+ 'rt-liber-sort-by-time-created
+ "Default sorting function.")
+
+(defvar rt-liber-browser-default-filter-function
+ 'rt-liber-default-filter-f
+ "Default filtering function.
+This is a function which accepts the ticket alist as a single
+argument and returns nil if the ticket needs to be filtered out,
+dropped or ignored (however you wish to put it.), otherwise the
+function returns a truth value.")
+
+(defvar rt-liber-browser-time-format-string "%b %d %Y %H:%M"
+ "String passed to `format-time-string' in the ticket browser.")
+
+(defvar rt-liber-browser-priority-cutoff 0
+ "Tickets with a priority higher than this are high priority.")
+
+(defgroup rt-liber nil
+ "*rt-liberation, the Emacs interface to RT"
+ :prefix "rt-liber-"
+ :group 'rt-liber)
+
+(defface rt-liber-ticket-face
+ '((((class color) (background dark))
+ (:foreground "DarkSeaGreen"))
+ (((class color) (background light))
+ (:foreground "Blue"))
+ (((type tty) (class mono))
+ (:inverse-video t))
+ (t (:background "Blue")))
+ "Face for tickets in browser buffer.")
+
+(defface rt-liber-priority-ticket-face
+ '((((class color) (background dark))
+ (:foreground "Orange"))
+ (((class color) (background light))
+ (:foreground "Orange"))
+ (((type tty) (class mono))
+ (:inverse-video t))
+ (t (:background "Black")))
+ "Face for high priority tickets in browser buffer.")
+
+(defvar rt-liber-browser-do-refresh t
+ "When t, run `rt-liber-browser-refresh' otherwise disable it.")
+
+(defvar rt-liber-assoc-browser nil
+ "Browser associated with a ticket history.
+This variable is made buffer local for the ticket history")
+
+;;; ------------------------------------------------------------------
+
+(defun rt-liber-browser-mode-quit ()
+ "Bury the ticket browser."
+ (interactive)
+ (bury-buffer))
+
+(defconst rt-liber-browser-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "q") 'rt-liber-browser-mode-quit)
+ (define-key map (kbd "n") 'rt-liber-next-ticket-in-browser)
+ (define-key map (kbd "p") 'rt-liber-previous-ticket-in-browser)
+ (define-key map (kbd "RET") 'rt-liber-display-ticket-at-point)
+ (define-key map (kbd "g") 'revert-buffer)
+ (define-key map (kbd "G") 'rt-liber-browser-refresh-and-return)
+ (define-key map (kbd "a") 'rt-liber-browser-assign)
+ (define-key map (kbd "r") 'rt-liber-browser-resolve)
+ (define-key map (kbd "o") 'rt-liber-browser-open)
+ (define-key map (kbd "N") 'rt-liber-browser-new)
+ (define-key map (kbd "t") 'rt-liber-browser-take-ticket-at-point)
+ (define-key map (kbd "A") 'rt-liber-browser-ancillary-text)
+ (define-key map (kbd "SPC") 'scroll-up)
+ (define-key map (kbd "DEL") 'scroll-down)
+ (define-key map (kbd "M") 'rt-liber-mark-ticket-at-point)
+ (define-key map (kbd "P") 'rt-liber-browser-prioritize)
+ map)
+ "Key map for ticket browser.")
+
+(define-derived-mode rt-liber-browser-mode nil
+ "RT Liberation Browser"
+ "Major Mode for browsing RT tickets.
+\\{rt-liber-browser-mode-map}"
+ (set (make-local-variable 'revert-buffer-function)
+ #'rt-liber-browser-refresh)
+ (set (make-local-variable 'buffer-stale-function)
+ (lambda (&optional _noconfirm) 'slow))
+ (run-hooks 'rt-liber-browser-hook))
+
+(defun rt-liber-setup-browser-name (new)
+ (setq rt-liber-browser-buffer
+ (get-buffer-create
+ (if new
+ (generate-new-buffer-name
+ (if (stringp new)
+ new
+ rt-liber-browser-buffer-name))
+ (if (and (boundp 'rt-liber-query)
+ rt-liber-query)
+ (buffer-name)
+ rt-liber-browser-buffer-name)))))
+
+(defun rt-liber-browser-with-message (message &optional query new)
+ "Start the RT ticket browser and display MESSAGE."
+ (interactive)
+ (rt-liber-setup-browser-name new)
+ ;; setup stage (invisible to user)
+ (with-current-buffer rt-liber-browser-buffer
+ (let ((inhibit-read-only t))
+ (rt-liber-browser-mode)
+ (goto-char (point-min))
+ (rt-liber-ticketlist-browser-redraw nil query)
+ (newline 2)
+ (insert message)
+ (set (make-local-variable 'rt-liber-query) query)))
+ ;; display stage (user can see updates)
+ (switch-to-buffer rt-liber-browser-buffer)
+ (setq buffer-read-only t))
+
+(declare-function rt-liber-set-ancillary-text "rt-liberation-storage.el")
+
+(defun rt-liber-browser-ancillary-text ()
+ "Wrapper function around storage backend."
+ (interactive)
+ (when (not (featurep 'rt-liberation-storage))
+ (error "rt-liberation-storage isn't loaded"))
+ (let ((initial-contents ""))
+ (rt-liber-set-ancillary-text
+ (read-from-minibuffer "Text: " initial-contents))))
+
+(defun rt-liber-browser-startup (ticket-list &optional query new)
+ "Start the RT ticket browser."
+ (interactive)
+ (rt-liber-setup-browser-name new)
+ ;; setup stage (invisible to user)
+ (with-current-buffer rt-liber-browser-buffer
+ (let ((inhibit-read-only t))
+ (rt-liber-ticketlist-browser-redraw ticket-list query)
+ (goto-char (point-min))
+ (rt-liber-next-ticket-in-browser)
+ (rt-liber-browser-mode)
+ ;; store the ticket-list and the query which produced the buffer
+ ;; as buffer local variables
+ (set (make-local-variable 'rt-liber-ticket-list) ticket-list)
+ (set (make-local-variable 'rt-liber-query) query)))
+ ;; display stage (user can see updates)
+ (switch-to-buffer rt-liber-browser-buffer)
+ (setq buffer-read-only t))
+
+(defun rt-liber-browse-query (query &optional new)
+ "Run QUERY against the server and launch the browser.
+
+NEW if non-nil create additional browser buffer. If NEW is a
+string then that will be the name of the new buffer."
+ (interactive "Mquery: ")
+ (condition-case nil
+ (rt-liber-browser-startup
+ (rt-liber-rest-run-show-base-query
+ (rt-liber-rest-run-ls-query query))
+ query new)
+ (rt-liber-no-result-from-query-error
+ (rt-liber-browser-with-message "no results from query"
+ query new))))
+
+(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)))
+
+;; accept a ticket-alist object and return an alist mapping ticket
+;; properties to format characters for use in `rt-liber-format'.
+(defun rt-liber-format-function (ticket-alist)
+ "Return a pairing of TICKET-ALIST values to %-sequences."
+ (let* ((id (rt-liber-ticket-id-only ticket-alist))
+ (subject (cdr (assoc "Subject" ticket-alist)))
+ (status (cdr (assoc "Status" ticket-alist)))
+ (created (format-time-string
+ rt-liber-browser-time-format-string
+ (date-to-time
+ (cdr (assoc "Created" ticket-alist)))))
+ (resolved (cdr (assoc "Resolved" ticket-alist)))
+ (requestors (cdr (assoc "Requestors" ticket-alist)))
+ (creator (cdr (assoc "Creator" ticket-alist)))
+ (owner (rt-liber-ticket-owner-only ticket-alist))
+ (queue (cdr (assoc "Queue" ticket-alist)))
+ (anc (if rt-liber-anc-p
+ (rt-liber-get-ancillary-text
+ (rt-liber-ticket-id-only ticket-alist))
+ ""))
+ (priority (cdr (assoc "Priority" ticket-alist))))
+ (list (cons ?i (or id "N/A"))
+ (cons ?s (or subject "N/A"))
+ (cons ?c (or created "N/A"))
+ (cons ?S (or status "N/A"))
+ (cons ?r (or resolved "N/A"))
+ (cons ?R (or requestors "N/A"))
+ (cons ?C (or creator "N/A"))
+ (cons ?o (or owner "N/A"))
+ (cons ?q (or queue "N/A"))
+ (cons ?A (or anc ""))
+ (cons ?p (or priority "N/A")))))
+
+(defun rt-liber-browser-assoc (char alist)
+ "Process the %-sequence association."
+ (let ((v (cdr (assoc char alist))))
+ (cond ((eq char ?%) "%") ;; escape sequence for %
+ (t (or v "")))))
+
+(defun rt-liber-high-priority-p (ticket-alist)
+ "Return t if TICKET-ALIST is high priority.
+
+The ticket's priority is compared to the variable
+ `rt-liber-browser-priority-cutoff'."
+ (let ((p (rt-liber-ticket-priority-only ticket-alist)))
+ (if p
+ (< rt-liber-browser-priority-cutoff p)
+ nil)))
+
+(defun rt-liber-format (format ticket-alist)
+ "Substitute %-sequences in FORMAT."
+ (let ((alist (rt-liber-format-function ticket-alist)))
+ (replace-regexp-in-string
+ "%."
+ (lambda (str)
+ (rt-liber-browser-assoc (aref str 1) alist))
+ format t t)))
+
+(defun rt-liber-ticketlist-browser-redraw-f (ticket)
+ "Display TICKET."
+ (insert (rt-liber-format "[%c %i %S]" ticket))
+ (add-text-properties (point-at-bol)
+ (point-at-eol)
+ '(face rt-liber-ticket-face))
+ (when (rt-liber-high-priority-p ticket)
+ (let ((p (point)))
+ (insert (format " HIGH PRIORITY (%d)"
+ (rt-liber-ticket-priority-only ticket)))
+ (add-text-properties p
+ (point-at-eol)
+ '(face rt-liber-priority-ticket-face))))
+
+ (newline)
+ (insert (rt-liber-format " [%o] %R: %s" ticket))
+ (let ((p (point)))
+ (insert (rt-liber-format " %A" ticket))
+ (add-text-properties p (point)
+ '(face font-lock-comment-face)))
+ (newline))
+
+(declare-function rt-liber-ticket-marked-p
+ "rt-liberation-multi.el")
+
+(defun rt-liber-ticketlist-browser-redraw (ticketlist &optional query)
+ "Display TICKETLIST. Optionally display QUERY as well."
+ (erase-buffer)
+ (when query
+ (insert (format "Query: %s" query))
+ (newline)
+ (insert (format "%d tickets" (length ticketlist)))
+ (newline))
+ (when ticketlist
+ (let ((filtered-count 0))
+ (newline 2)
+ (dolist (ticket
+ (funcall rt-liber-browser-default-sorting-function
+ ticketlist))
+ ;; skip filtered tickets, but count how many have been skipped
+ (if (funcall rt-liber-browser-default-filter-function ticket)
+ (progn
+ ;; assumes that rt-liber-ticketlist-browser-redraw-f leaves
+ ;; point at the end of the ticket drawn
+ (let ((start (point)))
+ (funcall rt-liber-custom-ticket-redraw-function ticket)
+ (add-text-properties start
+ (point)
+ (list 'rt-ticket ticket))
+ (when (and (featurep 'rt-liberation-multi)
+ (rt-liber-ticket-marked-p ticket))
+ (add-text-properties start
+ (point)
+ '(face rt-liber-marked-ticket-face))))
+ (newline))
+ (setq filtered-count (1+ filtered-count))))
+ (when (< 0 filtered-count)
+ (insert (format "%d tickets not shown (filtered)" filtered-count))))))
+
+(defun rt-liber-browser-refresh (&optional _ignore-auto noconfirm)
+ (interactive)
+ (if rt-liber-query
+ (when (or rt-liber-browser-do-refresh
+ noconfirm)
+ ;; explicitly pass nil NEW to `rt-liber-browse-query'
+ (rt-liber-browse-query rt-liber-query nil))
+ (error "no buffer-local query")))
+
+(defun rt-liber-browser-refresh-and-return ()
+ (interactive)
+ (let ((id (rt-liber-browser-ticket-id-at-point)))
+ (rt-liber-browser-refresh)
+ (rt-liber-browser-move-point-to-ticket id)))
+
+;; This is just a special case of
+;; `rt-liber-browser-ticket-<PROPERTY>-at-point'
+(defun rt-liber-browser-ticket-id-at-point (&optional point)
+ "Return the ticket id for the ticket at buffer position.
+
+If POINT is nil then called on (point)."
+ (when (not point)
+ (setq point (point)))
+ (let ((value (rt-liber-ticket-id-only
+ (get-text-property point 'rt-ticket))))
+ (if value
+ value
+ (error "no such ticket property at point"))))
+
+(defun rt-liber-ticket-taken-p (ticket-alist)
+ "Return t if TICKET-ALIST is owned by Nobody."
+ (when (not ticket-alist)
+ (error "null argument"))
+ (let ((owner (rt-liber-ticket-owner-only ticket-alist)))
+ (if (string= owner "Nobody")
+ nil
+ t)))
+
+(defun rt-liber-next-ticket-in-browser ()
+ "Move point to the next ticket."
+ (interactive)
+ (let ((next (next-single-property-change (point) 'rt-ticket)))
+ (when next (goto-char next))))
+
+(defun rt-liber-previous-ticket-in-browser ()
+ "Move point to the previous ticket."
+ (interactive)
+ (let ((prev (previous-single-property-change (point) 'rt-ticket)))
+ (when prev (goto-char prev))))
+
+(defun rt-liber-display-ticket-at-point ()
+ "Display the contents of the ticket at point."
+ (interactive)
+ (let ((ticket-alist (get-text-property (point) 'rt-ticket)))
+ (rt-liber-display-ticket-history ticket-alist (current-buffer))))
+
+;; remove after release START
+(defun rt-liber-viewer2-display-ticket-at-point ()
+ "Display the contents of the ticket at point."
+ (interactive)
+ (let ((ticket-alist (get-text-property (point) 'rt-ticket)))
+ (rt-liber-viewer2-display-ticket-history ticket-alist (current-buffer))))
+;; remove after release END
+
+(defun rt-liber-browser-search (id)
+ "Return point where ticket with ID is displayed or nil."
+ (let ((p nil))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((point-id (rt-liber-ticket-id-only
+ (get-text-property (point) 'rt-ticket))))
+ (if
+ ;; (predicate) looks for the exceptional situation
+ (and point-id (string= id point-id))
+ ;; (consequent) we're done
+ (setq p (point))
+ ;; (alternative) continue looking
+ (while (and (not p)
+ (rt-liber-next-ticket-in-browser))
+ (let ((point-id (rt-liber-ticket-id-only
+ (get-text-property (point) 'rt-ticket))))
+ (when (string= id point-id)
+ (setq p (point))))))))
+ p))
+
+(defun rt-liber-browser-move-point-to-ticket (id)
+ "Move point to the beginning of ticket with ID."
+ (let ((p (rt-liber-browser-search id)))
+ (if p
+ (progn
+ (goto-char p)
+ (recenter-top-bottom))
+ (error "ticket #%s not found" id))))
+
+
+;;; --------------------------------------------------------
+;;; Ticket browser sorting
+;;; --------------------------------------------------------
+
+(defun rt-liber-lex-lessthan-p (a b field)
+ "Return t if A is lexicographically less than B in FIELD."
+ (let ((field-a (cdr (assoc field a)))
+ (field-b (cdr (assoc field b))))
+ (if (and field-a field-b)
+ (string-lessp field-a field-b)
+ (error "\"%s\" is not a valid ticket field" field))))
+
+(defun rt-liber-time-lessthan-p (a b field)
+ "Return t if A is chronologically less than B in FIELD."
+ (let ((field-a (cdr (assoc field a)))
+ (field-b (cdr (assoc field b))))
+ (if (and field-a field-b)
+ (time-less-p (date-to-time field-a)
+ (date-to-time field-b))
+ (error "\"%s\" is not a valid ticket field" field))))
+
+(defun rt-liber-sort-ticket-list (ticket-list sort-f)
+ "Return a copy of TICKET-LIST sorted by SORT-F."
+ (let ((seq (copy-sequence ticket-list)))
+ (sort seq sort-f)))
+
+(defun rt-liber-sort-by-owner (ticket-list)
+ "Sort TICKET-LIST lexicographically by owner."
+ (rt-liber-sort-ticket-list
+ ticket-list
+ #'(lambda (a b)
+ (rt-liber-lex-lessthan-p
+ a b (rt-liber-get-field-string 'owner)))))
+
+(defun rt-liber-sort-by-time-created (ticket-list)
+ "Sort TICKET-LIST in reverse chronological order."
+ (reverse
+ (rt-liber-sort-ticket-list
+ ticket-list
+ #'(lambda (a b)
+ (rt-liber-time-lessthan-p a b "Created")))))
+
+
+;;; --------------------------------------------------------
+;;; Ticket browser filtering
+;;; --------------------------------------------------------
+
+;; See the fine manual for example code.
+
+(defun rt-liber-default-filter-f (_ticket)
+ "The default filtering function for the ticket browser
+
+This function is really a placeholder for user custom functions,
+and as such always return t."
+ t)
+
+
+(provide 'rt-liberation-browser)
+
+;;; rt-liberation-browser.el ends here.
diff --git a/rt-liberation-report.el b/rt-liberation-report.el
index a60ae5b..4382d28 100644
--- a/rt-liberation-report.el
+++ b/rt-liberation-report.el
@@ -31,8 +31,6 @@
;;; Code:
-
-(require 'rt-liberation-rest)
(require 'rt-liberation)
(defvar rt-liber-report-csv-header
diff --git a/rt-liberation-rest.el b/rt-liberation-rest.el
index e266e15..b722ebc 100644
--- a/rt-liberation-rest.el
+++ b/rt-liberation-rest.el
@@ -34,6 +34,13 @@
(require 'auth-source)
+(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-rest-debug-buffer-name "*rt-liber-rest debug log*"
"Buffer name of debug capture.")
@@ -250,6 +257,84 @@
(rt-liber-rest-handle-response response-buffer)))
(message "edit command ended at %s" (current-time-string)))
+(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-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)))
+
+(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-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-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))
+
+;;; --------------------------------------------------------
+;;; 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)))
+
(provide 'rt-liberation-rest)
diff --git a/rt-liberation-storage.el b/rt-liberation-storage.el
index f8e6884..379b508 100644
--- a/rt-liberation-storage.el
+++ b/rt-liberation-storage.el
@@ -22,8 +22,12 @@
;; MA 02111-1307, USA.
;;; Code:
+(require 'rt-liberation-browser)
-(require 'rt-liberation)
+(defcustom rt-liber-directory "~/.emacs.d/rt-liber"
+ "*Directory to store persistent information."
+ :type 'string
+ :group 'rt-liber)
(defvar rt-liber-store nil
"In memory storage for ticket metadata.")
@@ -76,7 +80,6 @@
;;; ------------------------------------------------------------------
;;; Interface
;;; ------------------------------------------------------------------
-
(defun rt-liber-set-ancillary-text (text)
"Store ancillary string TEXT for the ticket at point."
(let ((id (rt-liber-browser-ticket-id-at-point))
diff --git a/rt-liberation-update.el b/rt-liberation-update.el
index 17ddba3..ed33438 100644
--- a/rt-liberation-update.el
+++ b/rt-liberation-update.el
@@ -29,8 +29,9 @@
;;; Usage:
;;
-
(require 'rt-liberation)
+(require 'rt-liberation-storage)
+
(defgroup rt-liber-update nil
"*Check updates for rt-liberation."
diff --git a/rt-liberation-viewer.el b/rt-liberation-viewer.el
index e07186d..10d4799 100644
--- a/rt-liberation-viewer.el
+++ b/rt-liberation-viewer.el
@@ -25,11 +25,15 @@
;;; Comments:
;; By the end of 2020 is was clear that a more robust way of viewing
;; tickets was preferable.
-
+(require 'rt-liberation-rest)
+(require 'rt-liberation-browser)
;;; Code:
-(require 'rt-liberation)
+(defvar rt-liber-jump-to-latest nil
+ "jump to the latest correspondence when viewing a ticket.")
+(defvar rt-liber-content-regexp "^Content:.*$"
+ "Regular expression for section headers.")
(defvar rt-liber-viewer-section-header-regexp
"^# [0-9]+/[0-9]+ (id/[0-9]+/total)")
@@ -49,31 +53,7 @@
'font-lock-comment-face)))
"Expressions to font-lock for RT ticket viewer.")
-(defun rt-liber-display-ticket-history (ticket-alist &optional assoc-browser)
- "Display history for ticket.
-TICKET-ALIST alist of ticket data.
-ASSOC-BROWSER if non-nil should be a ticket browser."
- (let* ((ticket-id (rt-liber-ticket-id-only ticket-alist))
- (contents (rt-liber-rest-run-ticket-history-base-query ticket-id))
- (new-ticket-buffer (get-buffer-create
- (concat "*RT Ticket #" ticket-id "*"))))
- (with-current-buffer new-ticket-buffer
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert contents)
- (goto-char (point-min))
- (rt-liber-viewer-mode)
- (set
- (make-local-variable 'rt-liber-ticket-local)
- ticket-alist)
- (when assoc-browser
- (set
- (make-local-variable 'rt-liber-assoc-browser)
- assoc-browser))
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)))
- (switch-to-buffer new-ticket-buffer)))
;;; ------------------------------------------------------------------
@@ -239,13 +219,9 @@ ASSOC-BROWSER if non-nil should be a ticket browser."
(rt-liber-viewer2-display-history contents)
(goto-char (point-min))
(rt-liber-viewer2-mode)
- (set
- (make-local-variable 'rt-liber-ticket-local)
- ticket-alist)
+ (set (make-local-variable 'rt-liber-ticket-local) ticket-alist)
(when assoc-browser
- (set
- (make-local-variable 'rt-liber-assoc-browser)
- assoc-browser))
+ (set (make-local-variable 'rt-liber-assoc-browser) assoc-browser))
(set-buffer-modified-p nil)
(setq buffer-read-only t)))
(switch-to-buffer new-ticket-buffer)))
@@ -295,6 +271,39 @@ ASSOC-BROWSER if non-nil should be a ticket browser."
;;; ------------------------------------------------------------------
;;; viewer mode functions
;;; ------------------------------------------------------------------
+(defun rt-liber-refresh-ticket-history (&optional _ignore-auto _noconfirm)
+ (interactive)
+ (if rt-liber-ticket-local
+ (rt-liber-display-ticket-history rt-liber-ticket-local
+ rt-liber-assoc-browser)
+ (error "not viewing a ticket")))
+
+(defun rt-liber-display-ticket-history (ticket-alist &optional assoc-browser)
+ "Display history for ticket.
+
+TICKET-ALIST alist of ticket data.
+ASSOC-BROWSER if non-nil should be a ticket browser."
+ (let* ((ticket-id (rt-liber-ticket-id-only ticket-alist))
+ (contents (rt-liber-rest-run-ticket-history-base-query ticket-id))
+ (new-ticket-buffer (get-buffer-create
+ (concat "*RT Ticket #" ticket-id "*"))))
+ (with-current-buffer new-ticket-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert contents)
+ (goto-char (point-min))
+ (rt-liber-viewer-mode)
+ (set
+ (make-local-variable 'rt-liber-ticket-local)
+ ticket-alist)
+ (when assoc-browser
+ (set
+ (make-local-variable 'rt-liber-assoc-browser)
+ assoc-browser))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)))
+ (switch-to-buffer new-ticket-buffer)))
+
(defun rt-liber-jump-to-latest-correspondence ()
"Move point to the newest correspondence section."
(interactive)
diff --git a/rt-liberation.el b/rt-liberation.el
index 9fbcdf5..eae4129 100644
--- a/rt-liberation.el
+++ b/rt-liberation.el
@@ -44,19 +44,9 @@
(require 'cl-lib)
(require 'rt-liberation-rest)
+(require 'rt-liberation-browser)
+(require 'rt-liberation-viewer)
-(declare-function rt-liber-display-ticket-history "rt-liberation-viewer.el" (ticket-alist &optional assoc-browser))
-
-
-(defgroup rt-liber nil
- "*rt-liberation, the Emacs interface to RT"
- :prefix "rt-liber-"
- :group 'rt-liber)
-
-(defcustom rt-liber-directory "~/.emacs.d/rt-liber"
- "*Directory to store persistent information."
- :type 'string
- :group 'rt-liber)
(defvar rt-liber-created-string "Created"
"String representation of \"created\" query tag.")
@@ -64,9 +54,6 @@
(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.")
@@ -94,100 +81,21 @@
(defvar rt-liber-content-regexp "^Content:.*$"
"Regular expression for section headers.")
-(defvar rt-liber-correspondence-regexp
- "^Type: \\(EmailRecord\\|CommentEmailRecord\\|Correspond\\)"
- "Regular expression for correspondence sections.")
-
(defvar rt-liber-username nil
"Username for assigning ownership on the RT server.")
-(defvar rt-liber-browser-buffer-name "*ticket-browser*"
- "Name of ticket browser buffer.")
-
-(defvar rt-liber-browser-buffer nil
- "Ticket browser buffer.")
-
-(defvar rt-liber-browser-default-sorting-function
- 'rt-liber-sort-by-time-created
- "Default sorting function.")
-
-(defvar rt-liber-browser-default-filter-function
- 'rt-liber-default-filter-f
- "Default filtering function.
-
-This is a function which accepts the ticket alist as a single
-argument and returns nil if the ticket needs to be filtered out,
-dropped or ignored (however you wish to put it.), otherwise the
-function returns a truth value.")
-
-(defvar rt-liber-custom-ticket-redraw-function
- '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.")
-
-(defvar rt-liber-anc-p nil
- "Display ancillary data for tickets.")
-
-(defvar rt-liber-ticket-list nil
- "Ticket-list structure (becomes ticket-browser buffer local).")
-
-(defvar rt-liber-query nil
- "Query structure (becomes ticket-browser buffer local).")
-
-(defvar rt-liber-browser-time-format-string "%b %d %Y %H:%M"
- "String passed to `format-time-string' in the ticket browser.")
-
-(defvar rt-liber-browser-priority-cutoff 0
- "Tickets with a priority higher than this are high priority.")
-
-(defface rt-liber-ticket-face
- '((((class color) (background dark))
- (:foreground "DarkSeaGreen"))
- (((class color) (background light))
- (:foreground "Blue"))
- (((type tty) (class mono))
- (:inverse-video t))
- (t (:background "Blue")))
- "Face for tickets in browser buffer.")
-
-(defface rt-liber-priority-ticket-face
- '((((class color) (background dark))
- (:foreground "Orange"))
- (((class color) (background light))
- (:foreground "Orange"))
- (((type tty) (class mono))
- (:inverse-video t))
- (t (:background "Black")))
- "Face for high priority tickets in browser buffer.")
-
-(defvar rt-liber-browser-do-refresh t
- "When t, run `rt-liber-browser-refresh' otherwise disable it.")
-
(defvar rt-liber-command-dictionary
'((comment . "comment")
(edit . "edit"))
"Mapping between command symbols and command strings.
-
The command symbols provide the programmer with a consistent way
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")
@@ -199,37 +107,7 @@ 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")
-
-(defvar rt-liber-assoc-browser nil
- "Browser associated with a ticket history.
-
-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)))
;;; --------------------------------------------------------
@@ -344,15 +222,7 @@ AFTER date after predicate."
;;; 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)))
+
;;; --------------------------------------------------------
@@ -367,60 +237,7 @@ AFTER date after predicate."
'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))
+
;;; --------------------------------------------------------
@@ -436,330 +253,10 @@ AFTER date after predicate."
(<= 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
-;;; --------------------------------------------------------
-
-(declare-function
- rt-liber-get-ancillary-text
- "rt-liberation-storage.el")
-
-;; accept a ticket-alist object and return an alist mapping ticket
-;; properties to format characters for use in `rt-liber-format'.
-(defun rt-liber-format-function (ticket-alist)
- "Return a pairing of TICKET-ALIST values to %-sequences."
- (let* ((id (rt-liber-ticket-id-only ticket-alist))
- (subject (cdr (assoc "Subject" ticket-alist)))
- (status (cdr (assoc "Status" ticket-alist)))
- (created (format-time-string
- rt-liber-browser-time-format-string
- (date-to-time
- (cdr (assoc "Created" ticket-alist)))))
- (resolved (cdr (assoc "Resolved" ticket-alist)))
- (requestors (cdr (assoc "Requestors" ticket-alist)))
- (creator (cdr (assoc "Creator" ticket-alist)))
- (owner (rt-liber-ticket-owner-only ticket-alist))
- (queue (cdr (assoc "Queue" ticket-alist)))
- (anc (if rt-liber-anc-p
- (rt-liber-get-ancillary-text
- (rt-liber-ticket-id-only ticket-alist))
- ""))
- (priority (cdr (assoc "Priority" ticket-alist))))
- (list (cons ?i (or id "N/A"))
- (cons ?s (or subject "N/A"))
- (cons ?c (or created "N/A"))
- (cons ?S (or status "N/A"))
- (cons ?r (or resolved "N/A"))
- (cons ?R (or requestors "N/A"))
- (cons ?C (or creator "N/A"))
- (cons ?o (or owner "N/A"))
- (cons ?q (or queue "N/A"))
- (cons ?A (or anc ""))
- (cons ?p (or priority "N/A")))))
-
-(defun rt-liber-browser-assoc (char alist)
- "Process the %-sequence association."
- (let ((v (cdr (assoc char alist))))
- (cond ((eq char ?%) "%") ;; escape sequence for %
- (t (or v "")))))
-
-(defun rt-liber-high-priority-p (ticket-alist)
- "Return t if TICKET-ALIST is high priority.
-
-The ticket's priority is compared to the variable
- `rt-liber-browser-priority-cutoff'."
- (let ((p (rt-liber-ticket-priority-only ticket-alist)))
- (if p
- (< rt-liber-browser-priority-cutoff p)
- nil)))
-
-(defun rt-liber-format (format ticket-alist)
- "Substitute %-sequences in FORMAT."
- (let ((alist (rt-liber-format-function ticket-alist)))
- (replace-regexp-in-string
- "%."
- (lambda (str)
- (rt-liber-browser-assoc (aref str 1) alist))
- format t t)))
-
-(defun rt-liber-ticketlist-browser-redraw-f (ticket)
- "Display TICKET."
- (insert (rt-liber-format "[%c %i %S]" ticket))
- (add-text-properties (point-at-bol)
- (point-at-eol)
- '(face rt-liber-ticket-face))
- (when (rt-liber-high-priority-p ticket)
- (let ((p (point)))
- (insert (format " HIGH PRIORITY (%d)"
- (rt-liber-ticket-priority-only ticket)))
- (add-text-properties p
- (point-at-eol)
- '(face rt-liber-priority-ticket-face))))
-
- (newline)
- (insert (rt-liber-format " [%o] %R: %s" ticket))
- (let ((p (point)))
- (insert (rt-liber-format " %A" ticket))
- (add-text-properties p (point)
- '(face font-lock-comment-face)))
- (newline))
-
-(declare-function rt-liber-ticket-marked-p
- "rt-liberation-multi.el")
-
-(defun rt-liber-ticketlist-browser-redraw (ticketlist &optional query)
- "Display TICKETLIST. Optionally display QUERY as well."
- (erase-buffer)
- (when query
- (insert (format "Query: %s" query))
- (newline)
- (insert (format "%d tickets" (length ticketlist)))
- (newline))
- (when ticketlist
- (let ((filtered-count 0))
- (newline 2)
- (dolist (ticket
- (funcall rt-liber-browser-default-sorting-function
- ticketlist))
- ;; skip filtered tickets, but count how many have been skipped
- (if (funcall rt-liber-browser-default-filter-function ticket)
- (progn
- ;; assumes that rt-liber-ticketlist-browser-redraw-f leaves
- ;; point at the end of the ticket drawn
- (let ((start (point)))
- (funcall rt-liber-custom-ticket-redraw-function ticket)
- (add-text-properties start
- (point)
- (list 'rt-ticket ticket))
- (when (and (featurep 'rt-liberation-multi)
- (rt-liber-ticket-marked-p ticket))
- (add-text-properties start
- (point)
- '(face rt-liber-marked-ticket-face))))
- (newline))
- (setq filtered-count (1+ filtered-count))))
- (when (< 0 filtered-count)
- (insert (format "%d tickets not shown (filtered)" filtered-count))))))
-
-(defun rt-liber-browser-refresh (&optional _ignore-auto noconfirm)
- (interactive)
- (if rt-liber-query
- (when (or rt-liber-browser-do-refresh
- noconfirm)
- ;; explicitly pass nil NEW to `rt-liber-browse-query'
- (rt-liber-browse-query rt-liber-query nil))
- (error "no buffer-local query")))
-
-(defun rt-liber-browser-refresh-and-return ()
- (interactive)
- (let ((id (rt-liber-browser-ticket-id-at-point)))
- (rt-liber-browser-refresh)
- (rt-liber-browser-move-point-to-ticket id)))
-
-;; This is just a special case of
-;; `rt-liber-browser-ticket-<PROPERTY>-at-point'
-(defun rt-liber-browser-ticket-id-at-point (&optional point)
- "Return the ticket id for the ticket at buffer position.
-
-If POINT is nil then called on (point)."
- (when (not point)
- (setq point (point)))
- (let ((value (rt-liber-ticket-id-only
- (get-text-property point 'rt-ticket))))
- (if value
- value
- (error "no such ticket property at point"))))
-
-(defun rt-liber-ticket-taken-p (ticket-alist)
- "Return t if TICKET-ALIST is owned by Nobody."
- (when (not ticket-alist)
- (error "null argument"))
- (let ((owner (rt-liber-ticket-owner-only ticket-alist)))
- (if (string= owner "Nobody")
- nil
- t)))
-
-(defun rt-liber-next-ticket-in-browser ()
- "Move point to the next ticket."
- (interactive)
- (let ((next (next-single-property-change (point) 'rt-ticket)))
- (when next (goto-char next))))
-
-(defun rt-liber-previous-ticket-in-browser ()
- "Move point to the previous ticket."
- (interactive)
- (let ((prev (previous-single-property-change (point) 'rt-ticket)))
- (when prev (goto-char prev))))
-
-(defun rt-liber-display-ticket-at-point ()
- "Display the contents of the ticket at point."
- (interactive)
- (let ((ticket-alist (get-text-property (point) 'rt-ticket)))
- (rt-liber-display-ticket-history ticket-alist (current-buffer))))
-
-;; remove after release START
-(defun rt-liber-viewer2-display-ticket-at-point ()
- "Display the contents of the ticket at point."
- (interactive)
- (let ((ticket-alist (get-text-property (point) 'rt-ticket)))
- (rt-liber-viewer2-display-ticket-history ticket-alist (current-buffer))))
-;; remove after release END
-
-(defun rt-liber-browser-search (id)
- "Return point where ticket with ID is displayed or nil."
- (let ((p nil))
- (save-excursion
- (goto-char (point-min))
- (let ((point-id (rt-liber-ticket-id-only
- (get-text-property (point) 'rt-ticket))))
- (if
- ;; (predicate) looks for the exceptional situation
- (and point-id (string= id point-id))
- ;; (consequent) we're done
- (setq p (point))
- ;; (alternative) continue looking
- (while (and (not p)
- (rt-liber-next-ticket-in-browser))
- (let ((point-id (rt-liber-ticket-id-only
- (get-text-property (point) 'rt-ticket))))
- (when (string= id point-id)
- (setq p (point))))))))
- p))
-
-(defun rt-liber-browser-move-point-to-ticket (id)
- "Move point to the beginning of ticket with ID."
- (let ((p (rt-liber-browser-search id)))
- (if p
- (progn
- (goto-char p)
- (recenter-top-bottom))
- (error "ticket #%s not found" id))))
-
-
-;;; --------------------------------------------------------
-;;; Ticket browser sorting
-;;; --------------------------------------------------------
-
-(defun rt-liber-lex-lessthan-p (a b field)
- "Return t if A is lexicographically less than B in FIELD."
- (let ((field-a (cdr (assoc field a)))
- (field-b (cdr (assoc field b))))
- (if (and field-a field-b)
- (string-lessp field-a field-b)
- (error "\"%s\" is not a valid ticket field" field))))
-
-(defun rt-liber-time-lessthan-p (a b field)
- "Return t if A is chronologically less than B in FIELD."
- (let ((field-a (cdr (assoc field a)))
- (field-b (cdr (assoc field b))))
- (if (and field-a field-b)
- (time-less-p (date-to-time field-a)
- (date-to-time field-b))
- (error "\"%s\" is not a valid ticket field" field))))
-
-(defun rt-liber-sort-ticket-list (ticket-list sort-f)
- "Return a copy of TICKET-LIST sorted by SORT-F."
- (let ((seq (copy-sequence ticket-list)))
- (sort seq sort-f)))
-
-(defun rt-liber-sort-by-owner (ticket-list)
- "Sort TICKET-LIST lexicographically by owner."
- (rt-liber-sort-ticket-list
- ticket-list
- #'(lambda (a b)
- (rt-liber-lex-lessthan-p
- a b (rt-liber-get-field-string 'owner)))))
-
-(defun rt-liber-sort-by-time-created (ticket-list)
- "Sort TICKET-LIST in reverse chronological order."
- (reverse
- (rt-liber-sort-ticket-list
- ticket-list
- #'(lambda (a b)
- (rt-liber-time-lessthan-p a b "Created")))))
-
-
-;;; --------------------------------------------------------
-;;; Ticket browser filtering
-;;; --------------------------------------------------------
-
-;; See the fine manual for example code.
-
-(defun rt-liber-default-filter-f (_ticket)
- "The default filtering function for the ticket browser
-
-This function is really a placeholder for user custom functions,
-and as such always return t."
- t)
-
;;; --------------------------------------------------------
;;; Entry points
;;; --------------------------------------------------------
-
-(defun rt-liber-browse-query (query &optional new)
- "Run QUERY against the server and launch the browser.
-
-NEW if non-nil create additional browser buffer. If NEW is a
-string then that will be the name of the new buffer."
- (interactive "Mquery: ")
- (condition-case nil
- (rt-liber-browser-startup
- (rt-liber-rest-run-show-base-query
- (rt-liber-rest-run-ls-query query))
- query new)
- (rt-liber-no-result-from-query-error
- (rt-liber-browser-with-message "no results from query"
- query new))))
-
(defun rt-liber-print-query (query &optional ticket-redraw-f)
"Run QUERY against the server and return a string.
@@ -783,108 +280,6 @@ returned as no associated text properties."
query)))
out))
-
-;;; --------------------------------------------------------
-;;; Major mode definitions
-;;; --------------------------------------------------------
-
-(defun rt-liber-browser-mode-quit ()
- "Bury the ticket browser."
- (interactive)
- (bury-buffer))
-
-(defconst rt-liber-browser-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "q") 'rt-liber-browser-mode-quit)
- (define-key map (kbd "n") 'rt-liber-next-ticket-in-browser)
- (define-key map (kbd "p") 'rt-liber-previous-ticket-in-browser)
- (define-key map (kbd "RET") 'rt-liber-display-ticket-at-point)
- (define-key map (kbd "g") 'revert-buffer)
- (define-key map (kbd "G") 'rt-liber-browser-refresh-and-return)
- (define-key map (kbd "a") 'rt-liber-browser-assign)
- (define-key map (kbd "r") 'rt-liber-browser-resolve)
- (define-key map (kbd "o") 'rt-liber-browser-open)
- (define-key map (kbd "N") 'rt-liber-browser-new)
- (define-key map (kbd "t") 'rt-liber-browser-take-ticket-at-point)
- (define-key map (kbd "A") 'rt-liber-browser-ancillary-text)
- (define-key map (kbd "SPC") 'scroll-up)
- (define-key map (kbd "DEL") 'scroll-down)
- (define-key map (kbd "M") 'rt-liber-mark-ticket-at-point)
- (define-key map (kbd "P") 'rt-liber-browser-prioritize)
- map)
- "Key map for ticket browser.")
-
-(define-derived-mode rt-liber-browser-mode nil
- "RT Liberation Browser"
- "Major Mode for browsing RT tickets.
-\\{rt-liber-browser-mode-map}"
- (set (make-local-variable 'revert-buffer-function)
- #'rt-liber-browser-refresh)
- (set (make-local-variable 'buffer-stale-function)
- (lambda (&optional _noconfirm) 'slow))
- (run-hooks 'rt-liber-browser-hook))
-
-(defun rt-liber-setup-browser-name (new)
- (setq rt-liber-browser-buffer
- (get-buffer-create
- (if new
- (generate-new-buffer-name
- (if (stringp new)
- new
- rt-liber-browser-buffer-name))
- (if (and (boundp 'rt-liber-query)
- rt-liber-query)
- (buffer-name)
- rt-liber-browser-buffer-name)))))
-
-(defun rt-liber-browser-with-message (message &optional query new)
- "Start the RT ticket browser and display MESSAGE."
- (interactive)
- (rt-liber-setup-browser-name new)
- ;; setup stage (invisible to user)
- (with-current-buffer rt-liber-browser-buffer
- (let ((inhibit-read-only t))
- (rt-liber-browser-mode)
- (goto-char (point-min))
- (rt-liber-ticketlist-browser-redraw nil query)
- (newline 2)
- (insert message)
- (set (make-local-variable 'rt-liber-query) query)))
- ;; display stage (user can see updates)
- (switch-to-buffer rt-liber-browser-buffer)
- (setq buffer-read-only t))
-
-(defun rt-liber-browser-startup (ticket-list &optional query new)
- "Start the RT ticket browser."
- (interactive)
- (rt-liber-setup-browser-name new)
- ;; setup stage (invisible to user)
- (with-current-buffer rt-liber-browser-buffer
- (let ((inhibit-read-only t))
- (rt-liber-ticketlist-browser-redraw ticket-list query)
- (goto-char (point-min))
- (rt-liber-next-ticket-in-browser)
- (rt-liber-browser-mode)
- ;; store the ticket-list and the query which produced the buffer
- ;; as buffer local variables
- (set (make-local-variable 'rt-liber-ticket-list) ticket-list)
- (set (make-local-variable 'rt-liber-query) query)))
- ;; display stage (user can see updates)
- (switch-to-buffer rt-liber-browser-buffer)
- (setq buffer-read-only t))
-
-(declare-function rt-liber-set-ancillary-text "rt-liberation-storage.el")
-
-(defun rt-liber-browser-ancillary-text ()
- "Wrapper function around storage backend."
- (interactive)
- (when (not (featurep 'rt-liberation-storage))
- (error "rt-liberation-storage isn't loaded"))
- (let ((initial-contents ""))
- (rt-liber-set-ancillary-text
- (read-from-minibuffer "Text: " initial-contents))))
-
-
;;; --------------------------------------------------------
;;; Command module
;;; --------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2025-11-04 13:51:03 +0000