;;; rt-liberation-browser.el --- Emacs interface to RT -*- lexical-binding: t; -*-
;; Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 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.