diff options
| -rw-r--r-- | rt-liberation-viewer.el | 470 | ||||
| -rw-r--r-- | rt-liberation.el | 475 |
2 files changed, 451 insertions, 494 deletions
diff --git a/rt-liberation-viewer.el b/rt-liberation-viewer.el deleted file mode 100644 index e07186d..0000000 --- a/rt-liberation-viewer.el +++ /dev/null @@ -1,470 +0,0 @@ -;;; rt-liberation-viewer.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. - - -;;; Comments: -;; By the end of 2020 is was clear that a more robust way of viewing -;; tickets was preferable. - - -;;; Code: -(require 'rt-liberation) - - -(defvar rt-liber-viewer-section-header-regexp - "^# [0-9]+/[0-9]+ (id/[0-9]+/total)") - -(defvar rt-liber-viewer-section-field-regexp - "^\\(.+\\): \\(.+\\)$") - -(defconst rt-liber-viewer-font-lock-keywords - (let ((header-regexp (regexp-opt '("id: " "Ticket: " "TimeTaken: " - "Type: " "Field: " "OldValue: " - "NewValue: " "Data: " - "Description: " "Created: " - "Creator: " "Attachments: ") - t))) - (list - (list (concat "^" header-regexp ".*$") 0 - '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))) - - -;;; ------------------------------------------------------------------ -;;; viewer2 mode functions -;;; ------------------------------------------------------------------ -(defun rt-liber-viewer-reduce (section-list f acc) - "A Not Invented Here tail-recursive reduce function." - (cond ((null (cdr section-list)) acc) - (t (rt-liber-viewer-reduce (cdr section-list) - f - (append acc (list - (funcall f - (car section-list) - (cadr section-list)))))))) - -;; According to: -;; "https://rt-wiki.bestpractical.com/wiki/REST#Ticket_History_Entry" -;; id: <history-id> -;; Ticket: <ticket-id> -;; TimeTaken: <...> -;; Type: <...> -;; Field: <...> -;; OldValue: <...> -;; NewValue: <...> -;; Data: <...> -;; Description: <...> - -;; Content: <lin1-0> -;; <line-1> -;; ... -;; <line-n> - -;; Creator: <...> -;; Created: <...> -;; Attachments: <...> -(defun rt-liber-viewer-parse-section (start end) - (goto-char start) - (when (not (re-search-forward - rt-liber-viewer-section-header-regexp - end t)) - (error "invalid section")) - (forward-line 2) - (let (section-field-alist - (rt-field-list - '(id Ticket TimeTaken Type Field - OldValue NewValue Data Description - Creator Created))) - ;; definitely error out if any of this doesn't work - (setq section-field-alist - (mapcar - (lambda (field-symbol) - (re-search-forward (format "^%s:" (symbol-name field-symbol)) end nil) - (cons field-symbol (buffer-substring (1+ (point)) (point-at-eol)))) - rt-field-list)) - ;; content - (goto-char start) - (let ((content-start (re-search-forward "^Content: " end nil)) - (content-end (progn - (re-search-forward "^Creator: " end nil) - (point-at-bol)))) - (append section-field-alist - `(,(cons 'Content - (buffer-substring content-start - content-end))))))) - -;; According to: -;; "https://rt-wiki.bestpractical.com/wiki/REST#Ticket_History" is of -;; the form: "# <n>/<n> (id/<history-id>/total)" -(defun rt-liber-viewer-parse-history (ticket-history) - "Parse the string TICKET-HISTORY." - (when (not (stringp ticket-history)) - (error "invalid ticket-history")) - (with-temp-buffer - (insert ticket-history) - (goto-char (point-min)) - ;; find history detail sections and procude a list of section - ;; (start . end) pairs - (let (section-point-list - section-list) - (while (re-search-forward rt-liber-viewer-section-header-regexp (point-max) t) - (setq section-point-list (append section-point-list - (list (point-at-bol))))) - (when (not section-point-list) - (error "no history detail sections found")) - (setq section-point-list (append section-point-list - (list (point-max))) - section-point-list (rt-liber-viewer-reduce section-point-list #'cons nil)) - ;; collect the sections - (setq section-list - (mapcar - (lambda (section-points) - (rt-liber-viewer-parse-section - (car section-points) - (cdr section-points))) - section-point-list)) - section-list))) - -(defun rt-liber-viewer2-format-content (content) - (with-temp-buffer - (insert content) - - ;; Convert the 9 leading whitespaces from RT's comment lines. - (goto-char (point-min)) - (insert " ") - (while (re-search-forward "^ " (point-max) t) - (replace-match " ")) - - (fill-region (point-min) - (point-max)) - - (buffer-substring (point-min) - (point-max)))) - -(defun rt-liber-viewer2-display-section (section) - (let ((ticket-id (alist-get 'Ticket section)) - (creator (alist-get 'Creator section)) - (date (alist-get 'Created section)) - (type (alist-get 'Type section)) - (content (alist-get 'Content section))) - (insert - (format "Ticket %s by %s on %s (-N- days ago) (%s)\n" - ticket-id - creator - date - type)) - (cond ((or (string= type "Status") - (string= type "CustomField") - ;; (string= type "EmailRecord") - (string= type "Set")) - 'nop-for-now) - (t (insert - (format "\n%s\n" - (rt-liber-viewer2-format-content content))))))) - -(defun rt-liber-viewer2-display-history (contents) - (let ((section-list (rt-liber-viewer-parse-history contents))) - (mapc - (lambda (section) - (rt-liber-viewer2-display-section section)) - section-list))) - -;; Before release: move this back to the top -(defconst rt-liber-viewer2-font-lock-keywords - (let ((header-regexp (regexp-opt '("id: ") - t))) - (list - (list (concat "^" header-regexp ".*$") 0 - 'font-lock-comment-face))) - "Expressions to font-lock for RT ticket viewer.") - -(defun rt-liber-viewer2-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 (Viewer) Ticket #" ticket-id "*")))) - (with-current-buffer new-ticket-buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (rt-liber-viewer2-display-history contents) - (goto-char (point-min)) - (rt-liber-viewer2-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-viewer2-refresh-ticket-history (&optional _ignore-auto _noconfirm) - (interactive) - (if rt-liber-ticket-local - (rt-liber-viewer2-display-ticket-history rt-liber-ticket-local - rt-liber-assoc-browser) - (error "not viewing a ticket"))) - -(defconst rt-liber-viewer2-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "q") 'rt-liber-viewer-mode-quit) - (define-key map (kbd "n") 'rt-liber-next-section-in-viewer) - (define-key map (kbd "N") 'rt-liber-jump-to-latest-correspondence) - (define-key map (kbd "p") 'rt-liber-previous-section-in-viewer) - (define-key map (kbd "V") 'rt-liber-viewer-visit-in-browser) - (define-key map (kbd "m") 'rt-liber-viewer-answer) - (define-key map (kbd "M") 'rt-liber-viewer-answer-this) - (define-key map (kbd "t") 'rt-liber-viewer-answer-provisionally) - (define-key map (kbd "T") 'rt-liber-viewer-answer-provisionally-this) - (define-key map (kbd "F") 'rt-liber-viewer-answer-verbatim-this) - (define-key map (kbd "c") 'rt-liber-viewer-comment) - (define-key map (kbd "C") 'rt-liber-viewer-comment-this) - (define-key map (kbd "g") 'revert-buffer) - (define-key map (kbd "SPC") 'scroll-up) - (define-key map (kbd "DEL") 'scroll-down) - (define-key map (kbd "h") 'rt-liber-viewer-show-ticket-browser) - map) - "Key map for ticket viewer.") - -(define-derived-mode rt-liber-viewer2-mode nil - "RT Liberation Viewer" - "Major Mode for viewing RT tickets. -\\{rt-liber-viewer-mode-map}" - (set - (make-local-variable 'font-lock-defaults) - '((rt-liber-viewer2-font-lock-keywords))) - (set (make-local-variable 'revert-buffer-function) - #'rt-liber-viewer2-refresh-ticket-history) - (set (make-local-variable 'buffer-stale-function) - (lambda (&optional _noconfirm) 'slow)) - (run-hooks 'rt-liber-viewer-hook)) - - -;;; ------------------------------------------------------------------ -;;; viewer mode functions -;;; ------------------------------------------------------------------ -(defun rt-liber-jump-to-latest-correspondence () - "Move point to the newest correspondence section." - (interactive) - (let (latest-point) - (save-excursion - (goto-char (point-max)) - (when (re-search-backward rt-liber-correspondence-regexp - (point-min) t) - (setq latest-point (point)))) - (if latest-point - (progn - (goto-char latest-point) - (rt-liber-next-section-in-viewer)) - (message "no correspondence found")))) - -(defun rt-liber-viewer-visit-in-browser () - "Visit this ticket in the RT Web interface." - (interactive) - (let ((id (rt-liber-ticket-id-only rt-liber-ticket-local))) - (if id - (browse-url - (concat rt-liber-base-url "Ticket/Display.html?id=" id)) - (error "no ticket currently in view")))) - -(defun rt-liber-viewer-mode-quit () - "Bury the ticket viewer." - (interactive) - (bury-buffer)) - -(defun rt-liber-viewer-show-ticket-browser () - "Return to the ticket browser buffer." - (interactive) - (let ((id (rt-liber-ticket-id-only rt-liber-ticket-local))) - (if id - (let ((target-buffer - (if rt-liber-assoc-browser - (buffer-name rt-liber-assoc-browser) - (buffer-name rt-liber-browser-buffer-name)))) - (if target-buffer - (switch-to-buffer target-buffer) - (error "associated ticket browser buffer no longer exists")) - (rt-liber-browser-move-point-to-ticket id)) - (error "no ticket currently in view")))) - -(defun rt-liber-next-section-in-viewer () - "Move point to next section." - (interactive) - (forward-line 1) - (when (not (re-search-forward rt-liber-content-regexp (point-max) t)) - (message "no next section")) - (goto-char (point-at-bol))) - -(defun rt-liber-previous-section-in-viewer () - "Move point to previous section." - (interactive) - (forward-line -1) - (when (not (re-search-backward rt-liber-content-regexp (point-min) t)) - (message "no previous section")) - (goto-char (point-at-bol))) - -(defconst rt-liber-viewer-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "q") 'rt-liber-viewer-mode-quit) - (define-key map (kbd "n") 'rt-liber-next-section-in-viewer) - (define-key map (kbd "N") 'rt-liber-jump-to-latest-correspondence) - (define-key map (kbd "p") 'rt-liber-previous-section-in-viewer) - (define-key map (kbd "V") 'rt-liber-viewer-visit-in-browser) - (define-key map (kbd "m") 'rt-liber-viewer-answer) - (define-key map (kbd "M") 'rt-liber-viewer-answer-this) - (define-key map (kbd "t") 'rt-liber-viewer-answer-provisionally) - (define-key map (kbd "T") 'rt-liber-viewer-answer-provisionally-this) - (define-key map (kbd "F") 'rt-liber-viewer-answer-verbatim-this) - (define-key map (kbd "c") 'rt-liber-viewer-comment) - (define-key map (kbd "C") 'rt-liber-viewer-comment-this) - (define-key map (kbd "g") 'revert-buffer) - (define-key map (kbd "SPC") 'scroll-up) - (define-key map (kbd "DEL") 'scroll-down) - (define-key map (kbd "h") 'rt-liber-viewer-show-ticket-browser) - map) - "Key map for ticket viewer.") - -(define-derived-mode rt-liber-viewer-mode nil - "RT Liberation Viewer" - "Major Mode for viewing RT tickets. -\\{rt-liber-viewer-mode-map}" - (set - (make-local-variable 'font-lock-defaults) - '((rt-liber-viewer-font-lock-keywords))) - (set (make-local-variable 'revert-buffer-function) - #'rt-liber-refresh-ticket-history) - (set (make-local-variable 'buffer-stale-function) - (lambda (&optional _noconfirm) 'slow)) - (when rt-liber-jump-to-latest - (rt-liber-jump-to-latest-correspondence)) - (run-hooks 'rt-liber-viewer-hook)) - - -;; wrapper functions around specific functions provided by a backend -(declare-function - rt-liber-gnus-compose-reply-to-requestor - "rt-liberation-gnus.el") -(declare-function - rt-liber-gnus-compose-reply-to-requestor-to-this - "rt-liberation-gnus.el") -(declare-function - rt-liber-gnus-compose-reply-to-requestor-verbatim-this - "rt-liberation-gnus.el") -(declare-function - rt-liber-gnus-compose-provisional - "rt-liberation-gnus.el") -(declare-function - rt-liber-gnus-compose-provisional-to-this - "rt-liberation-gnus.el") -(declare-function - rt-liber-gnus-compose-comment - "rt-liberation-gnus.el") -(declare-function - rt-liber-gnus-compose-comment-this - "rt-liberation-gnus.el") - -(defun rt-liber-viewer-answer () - "Answer the ticket." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-reply-to-requestor)) - (t (error "no function defined")))) - -(defun rt-liber-viewer-answer-this () - "Answer the ticket using the current context." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-reply-to-requestor-to-this)) - (t (error "no function defined")))) - -(defun rt-liber-viewer-answer-verbatim-this () - "Answer the ticket using the current context verbatim." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-reply-to-requestor-verbatim-this)) - (t (error "no function defined")))) - -(defun rt-liber-viewer-answer-provisionally () - "Provisionally answer the ticket." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-provisional)) - (t (error "no function defined")))) - -(defun rt-liber-viewer-answer-provisionally-this () - "Provisionally answer the ticket using the current context." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-provisional-to-this)) - (t (error "no function defined")))) - -(defun rt-liber-viewer-comment () - "Comment on the ticket." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-comment)) - (t (error "no function defined")))) - -(defun rt-liber-viewer-comment-this () - "Comment on the ticket using the current context." - (interactive) - (cond ((featurep 'rt-liberation-gnus) - (rt-liber-gnus-compose-comment-this)) - (t (error "no function defined")))) - - -(provide 'rt-liberation-viewer) - -;;; rt-liberation-viewer.el ends here. diff --git a/rt-liberation.el b/rt-liberation.el index 9fbcdf5..143923c 100644 --- a/rt-liberation.el +++ b/rt-liberation.el @@ -38,14 +38,15 @@ ;;; Code: - (require 'browse-url) (require 'time-date) (require 'cl-lib) (require 'rt-liberation-rest) -(declare-function rt-liber-display-ticket-history "rt-liberation-viewer.el" (ticket-alist &optional assoc-browser)) +(declare-function rt-liber-get-ancillary-text "rt-liberation-storage.el") +(declare-function rt-liber-ticket-marked-p "rt-liberation-multi.el") +(declare-function rt-liber-set-ancillary-text "rt-liberation-storage.el") (defgroup rt-liber nil @@ -58,6 +59,24 @@ :type 'string :group 'rt-liber) +(defvar rt-liber-viewer-section-header-regexp + "^# [0-9]+/[0-9]+ (id/[0-9]+/total)") + +(defvar rt-liber-viewer-section-field-regexp + "^\\(.+\\): \\(.+\\)$") + +(defconst rt-liber-viewer-font-lock-keywords + (let ((header-regexp (regexp-opt '("id: " "Ticket: " "TimeTaken: " + "Type: " "Field: " "OldValue: " + "NewValue: " "Data: " + "Description: " "Created: " + "Creator: " "Attachments: ") + t))) + (list + (list (concat "^" header-regexp ".*$") 0 + 'font-lock-comment-face))) + "Expressions to font-lock for RT ticket viewer.") + (defvar rt-liber-created-string "Created" "String representation of \"created\" query tag.") @@ -426,7 +445,6 @@ AFTER date after predicate." ;;; -------------------------------------------------------- ;;; Ticket utilities ;;; -------------------------------------------------------- - (defun rt-liber-ticket-days-old (ticket-alist) "Return the age of the ticket in positive days." (days-between (format-time-string "%Y-%m-%dT%T%z" (current-time)) @@ -467,11 +485,6 @@ AFTER date after predicate." ;;; -------------------------------------------------------- ;;; 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) @@ -552,8 +565,7 @@ The ticket's priority is compared to the variable '(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." @@ -645,14 +657,6 @@ If POINT is nil then called on (point)." (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)) @@ -730,7 +734,6 @@ If POINT is nil then called on (point)." ;;; -------------------------------------------------------- ;;; Ticket browser filtering ;;; -------------------------------------------------------- - ;; See the fine manual for example code. (defun rt-liber-default-filter-f (_ticket) @@ -744,7 +747,6 @@ and as such always return t." ;;; -------------------------------------------------------- ;;; Entry points ;;; -------------------------------------------------------- - (defun rt-liber-browse-query (query &optional new) "Run QUERY against the server and launch the browser. @@ -787,7 +789,6 @@ returned as no associated text properties." ;;; -------------------------------------------------------- ;;; Major mode definitions ;;; -------------------------------------------------------- - (defun rt-liber-browser-mode-quit () "Bury the ticket browser." (interactive) @@ -873,8 +874,6 @@ returned as no associated text properties." (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) @@ -888,7 +887,6 @@ returned as no associated text properties." ;;; -------------------------------------------------------- ;;; Command module ;;; -------------------------------------------------------- - (defun rt-liber-command-get-dictionary-value (sym dic) "Utility function for retrieving alist values." (let ((value (cdr (assoc sym dic)))) @@ -1002,6 +1000,435 @@ returned as no associated text properties." (rt-liber-browser-assign rt-liber-username)) +;;; -------------------------------------------------------- +;;; 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))) + + +;;; ------------------------------------------------------------------ +;;; 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-jump-to-latest-correspondence () + "Move point to the newest correspondence section." + (interactive) + (let (latest-point) + (save-excursion + (goto-char (point-max)) + (when (re-search-backward rt-liber-correspondence-regexp + (point-min) t) + (setq latest-point (point)))) + (if latest-point + (progn + (goto-char latest-point) + (rt-liber-next-section-in-viewer)) + (message "no correspondence found")))) + +(defun rt-liber-viewer-visit-in-browser () + "Visit this ticket in the RT Web interface." + (interactive) + (let ((id (rt-liber-ticket-id-only rt-liber-ticket-local))) + (if id + (browse-url + (concat rt-liber-base-url "Ticket/Display.html?id=" id)) + (error "no ticket currently in view")))) + +(defun rt-liber-viewer-mode-quit () + "Bury the ticket viewer." + (interactive) + (bury-buffer)) + +(defun rt-liber-viewer-show-ticket-browser () + "Return to the ticket browser buffer." + (interactive) + (let ((id (rt-liber-ticket-id-only rt-liber-ticket-local))) + (if id + (let ((target-buffer + (if rt-liber-assoc-browser + (buffer-name rt-liber-assoc-browser) + (buffer-name rt-liber-browser-buffer-name)))) + (if target-buffer + (switch-to-buffer target-buffer) + (error "associated ticket browser buffer no longer exists")) + (rt-liber-browser-move-point-to-ticket id)) + (error "no ticket currently in view")))) + +(defun rt-liber-next-section-in-viewer () + "Move point to next section." + (interactive) + (forward-line 1) + (when (not (re-search-forward rt-liber-content-regexp (point-max) t)) + (message "no next section")) + (goto-char (point-at-bol))) + +(defun rt-liber-previous-section-in-viewer () + "Move point to previous section." + (interactive) + (forward-line -1) + (when (not (re-search-backward rt-liber-content-regexp (point-min) t)) + (message "no previous section")) + (goto-char (point-at-bol))) + +(defconst rt-liber-viewer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "q") 'rt-liber-viewer-mode-quit) + (define-key map (kbd "n") 'rt-liber-next-section-in-viewer) + (define-key map (kbd "N") 'rt-liber-jump-to-latest-correspondence) + (define-key map (kbd "p") 'rt-liber-previous-section-in-viewer) + (define-key map (kbd "V") 'rt-liber-viewer-visit-in-browser) + (define-key map (kbd "m") 'rt-liber-viewer-answer) + (define-key map (kbd "M") 'rt-liber-viewer-answer-this) + (define-key map (kbd "t") 'rt-liber-viewer-answer-provisionally) + (define-key map (kbd "T") 'rt-liber-viewer-answer-provisionally-this) + (define-key map (kbd "F") 'rt-liber-viewer-answer-verbatim-this) + (define-key map (kbd "c") 'rt-liber-viewer-comment) + (define-key map (kbd "C") 'rt-liber-viewer-comment-this) + (define-key map (kbd "g") 'revert-buffer) + (define-key map (kbd "SPC") 'scroll-up) + (define-key map (kbd "DEL") 'scroll-down) + (define-key map (kbd "h") 'rt-liber-viewer-show-ticket-browser) + map) + "Key map for ticket viewer.") + +(define-derived-mode rt-liber-viewer-mode nil + "RT Liberation Viewer" + "Major Mode for viewing RT tickets. +\\{rt-liber-viewer-mode-map}" + (set + (make-local-variable 'font-lock-defaults) + '((rt-liber-viewer-font-lock-keywords))) + (set (make-local-variable 'revert-buffer-function) + #'rt-liber-refresh-ticket-history) + (set (make-local-variable 'buffer-stale-function) + (lambda (&optional _noconfirm) 'slow)) + (when rt-liber-jump-to-latest + (rt-liber-jump-to-latest-correspondence)) + (run-hooks 'rt-liber-viewer-hook)) + +;; wrapper functions around specific functions provided by a backend +(declare-function + rt-liber-gnus-compose-reply-to-requestor + "rt-liberation-gnus.el") +(declare-function + rt-liber-gnus-compose-reply-to-requestor-to-this + "rt-liberation-gnus.el") +(declare-function + rt-liber-gnus-compose-reply-to-requestor-verbatim-this + "rt-liberation-gnus.el") +(declare-function + rt-liber-gnus-compose-provisional + "rt-liberation-gnus.el") +(declare-function + rt-liber-gnus-compose-provisional-to-this + "rt-liberation-gnus.el") +(declare-function + rt-liber-gnus-compose-comment + "rt-liberation-gnus.el") +(declare-function + rt-liber-gnus-compose-comment-this + "rt-liberation-gnus.el") + +(defun rt-liber-viewer-answer () + "Answer the ticket." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-reply-to-requestor)) + (t (error "no function defined")))) + +(defun rt-liber-viewer-answer-this () + "Answer the ticket using the current context." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-reply-to-requestor-to-this)) + (t (error "no function defined")))) + +(defun rt-liber-viewer-answer-verbatim-this () + "Answer the ticket using the current context verbatim." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-reply-to-requestor-verbatim-this)) + (t (error "no function defined")))) + +(defun rt-liber-viewer-answer-provisionally () + "Provisionally answer the ticket." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-provisional)) + (t (error "no function defined")))) + +(defun rt-liber-viewer-answer-provisionally-this () + "Provisionally answer the ticket using the current context." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-provisional-to-this)) + (t (error "no function defined")))) + +(defun rt-liber-viewer-comment () + "Comment on the ticket." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-comment)) + (t (error "no function defined")))) + +(defun rt-liber-viewer-comment-this () + "Comment on the ticket using the current context." + (interactive) + (cond ((featurep 'rt-liberation-gnus) + (rt-liber-gnus-compose-comment-this)) + (t (error "no function defined")))) + + +;;; ------------------------------------------------------------------ +;;; viewer2 functions +;;; ------------------------------------------------------------------ +(defun rt-liber-viewer-reduce (section-list f acc) + "A Not Invented Here tail-recursive reduce function." + (cond ((null (cdr section-list)) acc) + (t (rt-liber-viewer-reduce (cdr section-list) + f + (append acc (list + (funcall f + (car section-list) + (cadr section-list)))))))) + +;; According to: +;; "https://rt-wiki.bestpractical.com/wiki/REST#Ticket_History_Entry" +;; id: <history-id> +;; Ticket: <ticket-id> +;; TimeTaken: <...> +;; Type: <...> +;; Field: <...> +;; OldValue: <...> +;; NewValue: <...> +;; Data: <...> +;; Description: <...> + +;; Content: <lin1-0> +;; <line-1> +;; ... +;; <line-n> + +;; Creator: <...> +;; Created: <...> +;; Attachments: <...> +(defun rt-liber-viewer-parse-section (start end) + (goto-char start) + (when (not (re-search-forward + rt-liber-viewer-section-header-regexp + end t)) + (error "invalid section")) + (forward-line 2) + (let (section-field-alist + (rt-field-list + '(id Ticket TimeTaken Type Field + OldValue NewValue Data Description + Creator Created))) + ;; definitely error out if any of this doesn't work + (setq section-field-alist + (mapcar + (lambda (field-symbol) + (re-search-forward (format "^%s:" (symbol-name field-symbol)) end nil) + (cons field-symbol (buffer-substring (1+ (point)) (point-at-eol)))) + rt-field-list)) + ;; content + (goto-char start) + (let ((content-start (re-search-forward "^Content: " end nil)) + (content-end (progn + (re-search-forward "^Creator: " end nil) + (point-at-bol)))) + (append section-field-alist + `(,(cons 'Content + (buffer-substring content-start + content-end))))))) + +;; According to: +;; "https://rt-wiki.bestpractical.com/wiki/REST#Ticket_History" is of +;; the form: "# <n>/<n> (id/<history-id>/total)" +(defun rt-liber-viewer-parse-history (ticket-history) + "Parse the string TICKET-HISTORY." + (when (not (stringp ticket-history)) + (error "invalid ticket-history")) + (with-temp-buffer + (insert ticket-history) + (goto-char (point-min)) + ;; find history detail sections and procude a list of section + ;; (start . end) pairs + (let (section-point-list + section-list) + (while (re-search-forward rt-liber-viewer-section-header-regexp (point-max) t) + (setq section-point-list (append section-point-list + (list (point-at-bol))))) + (when (not section-point-list) + (error "no history detail sections found")) + (setq section-point-list (append section-point-list + (list (point-max))) + section-point-list (rt-liber-viewer-reduce section-point-list #'cons nil)) + ;; collect the sections + (setq section-list + (mapcar + (lambda (section-points) + (rt-liber-viewer-parse-section + (car section-points) + (cdr section-points))) + section-point-list)) + section-list))) + +(defun rt-liber-viewer2-format-content (content) + (with-temp-buffer + (insert content) + + ;; Convert the 9 leading whitespaces from RT's comment lines. + (goto-char (point-min)) + (insert " ") + (while (re-search-forward "^ " (point-max) t) + (replace-match " ")) + + (fill-region (point-min) + (point-max)) + + (buffer-substring (point-min) + (point-max)))) + +(defun rt-liber-viewer2-display-section (section) + (let ((ticket-id (alist-get 'Ticket section)) + (creator (alist-get 'Creator section)) + (date (alist-get 'Created section)) + (type (alist-get 'Type section)) + (content (alist-get 'Content section))) + (insert + (format "Ticket %s by %s on %s (-N- days ago) (%s)\n" + ticket-id + creator + date + type)) + (cond ((or (string= type "Status") + (string= type "CustomField") + ;; (string= type "EmailRecord") + (string= type "Set")) + 'nop-for-now) + (t (insert + (format "\n%s\n" + (rt-liber-viewer2-format-content content))))))) + +(defun rt-liber-viewer2-display-history (contents) + (let ((section-list (rt-liber-viewer-parse-history contents))) + (mapc + (lambda (section) + (rt-liber-viewer2-display-section section)) + section-list))) + +;; Before release: move this back to the top +(defconst rt-liber-viewer2-font-lock-keywords + (let ((header-regexp (regexp-opt '("id: ") + t))) + (list + (list (concat "^" header-regexp ".*$") 0 + 'font-lock-comment-face))) + "Expressions to font-lock for RT ticket viewer.") + +(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)))) + +(defun rt-liber-viewer2-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 (Viewer) Ticket #" ticket-id "*")))) + (with-current-buffer new-ticket-buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (rt-liber-viewer2-display-history contents) + (goto-char (point-min)) + (rt-liber-viewer2-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-viewer2-refresh-ticket-history (&optional _ignore-auto _noconfirm) + (interactive) + (if rt-liber-ticket-local + (rt-liber-viewer2-display-ticket-history rt-liber-ticket-local + rt-liber-assoc-browser) + (error "not viewing a ticket"))) + +(defconst rt-liber-viewer2-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "q") 'rt-liber-viewer-mode-quit) + (define-key map (kbd "n") 'rt-liber-next-section-in-viewer) + (define-key map (kbd "N") 'rt-liber-jump-to-latest-correspondence) + (define-key map (kbd "p") 'rt-liber-previous-section-in-viewer) + (define-key map (kbd "V") 'rt-liber-viewer-visit-in-browser) + (define-key map (kbd "m") 'rt-liber-viewer-answer) + (define-key map (kbd "M") 'rt-liber-viewer-answer-this) + (define-key map (kbd "t") 'rt-liber-viewer-answer-provisionally) + (define-key map (kbd "T") 'rt-liber-viewer-answer-provisionally-this) + (define-key map (kbd "F") 'rt-liber-viewer-answer-verbatim-this) + (define-key map (kbd "c") 'rt-liber-viewer-comment) + (define-key map (kbd "C") 'rt-liber-viewer-comment-this) + (define-key map (kbd "g") 'revert-buffer) + (define-key map (kbd "SPC") 'scroll-up) + (define-key map (kbd "DEL") 'scroll-down) + (define-key map (kbd "h") 'rt-liber-viewer-show-ticket-browser) + map) + "Key map for ticket viewer.") + +(define-derived-mode rt-liber-viewer2-mode nil + "RT Liberation Viewer" + "Major Mode for viewing RT tickets. +\\{rt-liber-viewer-mode-map}" + (set + (make-local-variable 'font-lock-defaults) + '((rt-liber-viewer2-font-lock-keywords))) + (set (make-local-variable 'revert-buffer-function) + #'rt-liber-viewer2-refresh-ticket-history) + (set (make-local-variable 'buffer-stale-function) + (lambda (&optional _noconfirm) 'slow)) + (run-hooks 'rt-liber-viewer-hook)) + + (provide 'rt-liberation) ;;; rt-liberation.el ends here. |