diff options
| -rw-r--r-- | rt-liberation-browser.el | 533 | ||||
| -rw-r--r-- | rt-liberation-report.el | 2 | ||||
| -rw-r--r-- | rt-liberation-rest.el | 85 | ||||
| -rw-r--r-- | rt-liberation-storage.el | 7 | ||||
| -rw-r--r-- | rt-liberation-update.el | 3 | ||||
| -rw-r--r-- | rt-liberation-viewer.el | 73 | ||||
| -rw-r--r-- | rt-liberation.el | 613 |
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 ;;; -------------------------------------------------------- |