diff options
Diffstat (limited to 'rt-liberation.el')
| -rw-r--r-- | rt-liberation.el | 613 |
1 files changed, 4 insertions, 609 deletions
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 ;;; -------------------------------------------------------- |