diff options
| author | Yoni Rabkin <yoni@rabkins.net> | 2020-11-23 16:28:51 -0500 | 
|---|---|---|
| committer | Yoni Rabkin <yoni@rabkins.net> | 2020-11-23 16:28:51 -0500 | 
| commit | 71f0e4c67eb174cab605139c73f9af23ae592445 (patch) | |
| tree | 1651e13da033fc5dc6c1faa6b8c588ebc6a434ed | |
| parent | fe585205b3fba238028a6682a8700224e5c4836c (diff) | |
bring the code backbefore-reshuffle
Previous attempt didn't go well.
| -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. | 
