diff options
Diffstat (limited to 'rt-liberation-browser.el')
| -rw-r--r-- | rt-liberation-browser.el | 533 |
1 files changed, 533 insertions, 0 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. |