File contents
;;; trac-ticket.el --- Trac ticket interface
;; Copyright (C) 2007 Taiki SUGAWARA <buzz.taiki@gmail.com>
;; Author: Taiki SUGAWARA <buzz.taiki@gmail.com>
;; Keywords: trac, xml-rpc
;; This file 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 2, or (at your option)
;; any later version.
;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Features:
;; * Editing cutom query (M-x trac-ticket-query).
;; * Show ticket directly (M-x trac-ticket).
;; * Listing ticket summary.
;; * Show ticket.
;; * Highlight ticket description and logs using trac-wiki.
;;; Requirements:
;; * Works on Emacs 22.
;; * need trac-wiki.el
;; (get it from http://www.meadowy.org/~gotoh/projects/trac-wiki/)
;; * need xml-rpc.el
;; (get it from http://cvs.savannah.nongnu.org/viewcvs/*checkout*/weblogger/lisp/xml-rpc.el?root=emacsweblogs)
;;; Configuration:
;; Put this, trac-wiki.el and xml-rpc.el in a directory on your `load-path'.
;; Put followings in your .emacs
;; (require 'trac-ticket)
;; (setq url-proxy-services '(("http" . "your.proxy.host:portnumber")) ; if needed
;; (add-to-list 'trac-projects '("project-name" :endpoint "http://www.some.host.org/proj/login/xmlrpc"))
;;; Usage:
;; Case1: editing custom query
;; 1. type M-x trac-ticket-query and enter project name.
;; 2. then query buffer is displayed.
;; 3. edit cutom queries.
;; 4. type C-cC-c.
;; 5. then summary buffer is displayed.
;; 6. move cursor to ticket for wants to see.
;; 7. type RET.
;; 8. then ticket buffer is displayed.
;; Case2: show ticket directly.
;; 1. type M-x trac-ticket and enter project name and ticket-id.
;; 2. then ticket buffer is displayed.
;; Case3: change project.
;; 1. type M-x trac-ticket-query or type M-x trac-ticket with prefix-argument.
;;; Todo:
;; * save custom query
;; * write ticket log
;; * write new ticket
;; * sort summary
;; * grouping summary
;; * browse ticket by external browser
;; * make checkbox to easy to look
;; * multiple project support
;; * docstring
;; * installation, usage, requirement
;;; Code:
(require 'trac-wiki)
(require 'widget)
(require 'cl)
;;; Variables
(defconst trac-ticket-version "0.0.3")
(defvar trac-ticket-field-extra-label-alist
'(("id" . "ID")
("created" . "Created")
("modified" . "Modified"))
"*A alist of field name to label.
These label has high priority from field label.")
(defvar trac-ticket-field-type-operator-alist
'(("text" . contains)
("radio" . is)
("select" . is))
"*A alist of field type to operator.")
(defvar trac-ticket-summary-format
'(("id" 6 right)
("status" 8 left)
("owner" 10 left)
("type" 11 left)
("priority" 7 left)
("milestone" 10 left)
("summary" nil left))
"*A alist of summary format.
This variable is a following form:
\(FORMAT FORMAT ...)
FORMAT is following:
\(NAME WIDTH ALIGN)
When summary is displayed, field value is truncated to WIDTH and aligned from ALIGN.
NAME is a name of field.
WIDTH can be number or nil. If WIDTH is nil, field value is not truncated.
ALIGN can be `left' or `right'.")
(defvar trac-ticket-ticket-header-format
'("#%s: [%s/%s/%s] %s"
"id" "status" "type" "priority" "summary")
"*A ticket header format.
This variable is a following form:
\(FORMAT NAME NAME ...)
FORMAT is a format string of `format'.
NAME is a name of field.
Field value corresponding to NAME is used to format parameter.")
(defvar trac-ticket-summary-separator "|"
"*A separator of summary.")
(defvar trac-ticket-time-format "%Y-%m-%d %H:%M:%S"
"*A date-time format of each date-times.
This variable can be format string of `format-time-string'.")
;; hooks
(defvar trac-ticket-query-mode-hook nil)
(defvar trac-ticket-query-after-create-hook nil)
(defvar trac-ticket-summary-mode-hook nil)
(defvar trac-ticket-summary-after-create-hook nil)
(defvar trac-ticket-ticket-mode-hook nil)
(defvar trac-ticket-ticket-after-create-hook nil)
;;; Keymaps
(defvar trac-ticket-query-mode-map
(let ((map (copy-keymap widget-keymap)))
(define-key map "\C-c\C-c" 'trac-ticket-query-do-search)
(define-key map "q" 'bury-buffer)
(define-key map " " 'scroll-up)
(define-key map [(shift ?\ )] 'scroll-down)
(define-key map "\C-?" 'scroll-down)
map))
(defvar trac-ticket-summary-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'trac-ticket-summary-select)
(define-key map "q" 'bury-buffer)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map " " 'scroll-up)
(define-key map [(shift ?\ )] 'scroll-down)
(define-key map "\C-?" 'scroll-down)
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
map))
(defvar trac-ticket-ticket-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" 'trac-ticket-ticket-quit)
(define-key map "f" 'trac-ticket-ticket-next-ticket)
(define-key map "b" 'trac-ticket-ticket-previous-ticket)
(define-key map "\r" 'trac-ticket-ticket-show-ticket-at-point)
(define-key map " " 'scroll-up)
(define-key map [(shift ?\ )] 'scroll-down)
(define-key map "\C-?" 'scroll-down)
(define-key map ">" 'end-of-buffer)
(define-key map "<" 'beginning-of-buffer)
map))
;;; Internal variables
(defvar trac-ticket-project-fields nil)
(defvar trac-ticket-current-project nil)
(defvar trac-ticket-buffer-project nil)
;; filter
(defconst trac-ticket-filter-operator-alist
'((contains . "~")
(contains-not . "!~")
(begins-with . "^")
(ends-with . "$")
(is . "")
(is-not . "!")))
;; query
(defvar trac-ticket-query-buffer-name "*trac-ticket-query*")
(defvar trac-ticket-query-retrieve-buffer-name "*trac-ticket-query-retrieve*")
(defvar trac-ticket-query-buffer-filter-alist nil)
;; summary
(defvar trac-ticket-summary-buffer-name "*trac-ticket-summary*")
(defvar trac-ticket-summary-compiled-format nil)
;; ticket
(defvar trac-ticket-ticket-buffer-name-format "*trac-ticket %s:%s*")
(defvar trac-ticket-ticket-extra-field-alist
'(("id" . trac-ticket-ticket-id)
("created" . (lambda (ticket)
(trac-ticket-format-time (trac-ticket-ticket-created ticket))))
("modified" . (lambda (ticket)
(trac-ticket-format-time (trac-ticket-ticket-modified ticket))))))
(defvar trac-ticket-ticket-syntax-table
(let ((tab (make-syntax-table)))
(modify-syntax-entry ?# "w" tab)
(modify-syntax-entry ?: "w" tab)
tab))
;;; Field
(defmacro trac-ticket-define-field-getter (name &optional docstring)
`(defun ,(intern (concat "trac-ticket-field-" (symbol-name name))) (field)
,docstring
(assoc-default ,(symbol-name name) field)))
(trac-ticket-define-field-getter name)
(trac-ticket-define-field-getter label)
(trac-ticket-define-field-getter options)
(trac-ticket-define-field-getter value)
(trac-ticket-define-field-getter optional)
(trac-ticket-define-field-getter order)
(trac-ticket-define-field-getter type)
(defun trac-ticket-field-alist (fields)
"Convert FIELDS to alist.
A each element spec is a \(NAME . FIELD)."
(mapcar (lambda (field)
(cons (trac-ticket-field-name field) field))
fields))
(defun trac-ticket-field-alist-label (field-alist name &optional add-extra-p)
"Get label by NAME from FIELD-ALIST.
If ADD-EXTRA-P is non-nil, `trac-ticket-field-extra-label-alist' is used prior than field label."
(or (and add-extra-p
(assoc-default name
trac-ticket-field-extra-label-alist))
(trac-ticket-field-label (assoc-default name field-alist))
name))
;;; Filter
(defun trac-ticket-filter (name value operator)
(list name value operator))
(defun trac-ticket-filter-name (filter)
(car filter))
(defun trac-ticket-filter-value (filter)
(nth 1 filter))
(defun trac-ticket-filter-operator (filter)
(nth 2 filter))
(defun trac-ticket-filter-to-string (filter)
"Convert filter to query parameter string."
(mapconcat 'url-hexify-string
(list
(trac-ticket-filter-name filter)
(concat (assoc-default (trac-ticket-filter-operator filter)
trac-ticket-filter-operator-alist)
(trac-ticket-filter-value filter)))
"="))
;;; Query
(defun trac-ticket-query-mode ()
"A cutom query editing mode.
\\{trac-ticket-query-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map trac-ticket-query-mode-map)
(setq major-mode 'trac-ticket-query-mode)
(setq mode-name "Trac-Ticket-Query")
(run-hooks 'trac-ticket-query-mode-hook))
(defun trac-ticket-query (project)
"Edit a custom query of PROJECT.
If you are not using trac-ticket yet, this command asks project of using.
If prefix argument is non-nil, this command asks project always."
(interactive
(list (trac-ticket-read-project current-prefix-arg)))
(switch-to-buffer trac-ticket-query-buffer-name)
(trac-ticket-query-mode)
(let ((fields (trac-ticket-get-fields project)))
(set (make-local-variable 'trac-ticket-buffer-project) project)
(make-local-variable 'trac-ticket-query-buffer-filter-alist)
(trac-ticket-query-create fields)))
(defun trac-ticket-query-create (fields)
"Create query buffer from FIELDS."
;; type: text radio select
;; name
;; label
;; options:
;; value
;; optional: t nil
(let ((inhibit-read-only t))
(erase-buffer)
(remove-overlays)
(dolist (field fields)
(cond
((string= (trac-ticket-field-type field) "text")
(apply 'widget-create
`(string
:tag ,(format "%15s" (trac-ticket-field-label field))
:ticket-field ,field
:create trac-ticket-query-widget-create
:notify trac-ticket-query-widget-notify)))
((member (trac-ticket-field-type field) '("select" "radio"))
(apply 'widget-create
`(checklist
;; :format "%{%t%}:\n%v\n"
:format "%{%t%}:\n%v"
;; :entry-format "%b %v "
:entry-format "%b %v\n"
:tag ,(format "%15s" (trac-ticket-field-label field))
;; :indent 2
:indent 15
:ticket-field ,field
:create trac-ticket-query-widget-create
:notify trac-ticket-query-widget-notify
,@(mapcar (lambda (option)
`(const :format "%v" :value ,option))
(trac-ticket-field-options field))))))))
(widget-setup)
(set-buffer-modified-p nil)
(goto-char (point-min))
(run-hooks 'trac-ticket-query-after-create-hook))
(defun trac-ticket-query-widget-create (widget)
"Create a widget of query."
(let ((super (get (widget-type widget) 'widget-type))
(field (widget-get widget :ticket-field)))
(funcall (widget-get super :create) widget)
(setq trac-ticket-query-buffer-filter-alist
(acons (trac-ticket-field-name field)
(trac-ticket-filter
(trac-ticket-field-name field)
(widget-value widget)
(assoc-default (trac-ticket-field-type field)
trac-ticket-field-type-operator-alist))
trac-ticket-query-buffer-filter-alist))))
(defun trac-ticket-query-widget-notify (widget child &optional event)
"Notify function for a widget editing."
(let* ((name (trac-ticket-field-name (widget-get widget :ticket-field)))
(filter (assoc-default name trac-ticket-query-buffer-filter-alist)))
(trac-ticket-set-alist
'trac-ticket-query-buffer-filter-alist
name
(trac-ticket-filter (trac-ticket-filter-name filter)
(widget-value widget)
(trac-ticket-filter-operator filter)))))
(defun trac-ticket-query-filter-alist-to-filters (filter-alist)
"Convert filter alist to filters.
Empty filter is banished.
Multi value filter is a extracted."
(trac-ticket-flatten
(mapcar
(lambda (filter)
(if (listp (trac-ticket-filter-value filter))
(mapcar
(lambda (value)
(trac-ticket-filter
(trac-ticket-filter-name filter)
value
(trac-ticket-filter-operator filter)))
(trac-ticket-filter-value filter))
(list filter)))
(remove-if (lambda (filter)
(let ((value (trac-ticket-filter-value filter)))
(or (null value)
(and (stringp value) (string= value "")))))
(mapcar 'cdr filter-alist)))))
(defun trac-ticket-query-do-search ()
"Do query search."
(interactive)
(let ((project trac-ticket-buffer-project))
(trac-ticket-summary
project
(trac-ticket-query-search
project
(trac-ticket-query-filter-alist-to-filters
trac-ticket-query-buffer-filter-alist)))))
(defun trac-ticket-query-url (project filters)
"Create query url from PROJECT and FILTERS.
This url hopes a response is a tab format."
(let ((url (trac-ticket-project-query-url project)))
(concat
url "?"
(mapconcat 'identity
(cons
"format=tab"
(mapcar 'trac-ticket-filter-to-string filters))
"&"))))
(defun trac-ticket-query-search (project filters)
"Search a tickets from PROJECT and FILTERS.
Return summary tickets."
(let* ((url-request-method "GET")
(buf (url-retrieve-synchronously
(trac-ticket-query-url project filters))))
(when (get-buffer trac-ticket-query-retrieve-buffer-name)
(kill-buffer trac-ticket-query-retrieve-buffer-name))
(with-current-buffer buf
(rename-buffer trac-ticket-query-retrieve-buffer-name))
(trac-ticket-query-parse-response buf)))
(defun trac-ticket-query-parse-response (buffer)
"Parse a custom query response from buffer."
(declare (special url-http-response-status
url-http-end-of-headers
url-http-content-type))
(let (result)
(with-current-buffer buffer
(set-buffer-multibyte t)
(when (not (= url-http-response-status 200))
(error "Query failed (status %s)" url-http-response-status))
(goto-char (1+ url-http-end-of-headers))
(decode-coding-region (point) (point-max) 'utf-8)
(let (header)
(when (re-search-forward ".+" nil t)
(setq header (split-string (match-string 0) "\t")))
(while (re-search-forward ".+" nil t)
(push
(mapcar* (lambda (k v) (cons k v))
header
(split-string (match-string 0) "\t"))
result))))
(nreverse result)))
;;; Summary
(defun trac-ticket-summary-mode ()
"A ticket summary mode.
\\{trac-ticket-summary-mode-map}"
(interactive)
(kill-all-local-variables)
(setq buffer-read-only t)
(setq truncate-lines t)
(use-local-map trac-ticket-summary-mode-map)
(setq major-mode 'trac-ticket-summary-mode)
(setq mode-name "Trac-Ticket-Summary")
(run-hooks 'trac-ticket-summary-mode-hook))
;; TODO change argument from tickets to filters
(defun trac-ticket-summary (project tickets)
"Enter a summary mode from PROJECT and TICKETS."
(switch-to-buffer trac-ticket-summary-buffer-name)
(trac-ticket-summary-mode)
(set (make-local-variable 'trac-ticket-buffer-project) project)
(trac-ticket-summary-create (trac-ticket-get-fields project) tickets))
(defun trac-ticket-summary-create (fields tickets)
"Create summary mode buffer from FIELDS and TICKETS."
(let ((inhibit-read-only t)
(field-alist (trac-ticket-field-alist fields)))
(erase-buffer)
(trac-ticket-summary-compile-format)
(insert
(trac-ticket-summary-format
(mapcar
(lambda (fmt)
(let ((name (car fmt)))
(cons name
(propertize (trac-ticket-field-alist-label field-alist name t)
'face 'bold))))
trac-ticket-summary-format))
"\n")
(dolist (ticket (sort tickets
(lambda (a b)
(< (trac-ticket-summary-ticket-id b)
(trac-ticket-summary-ticket-id a)))))
(let ((line (trac-ticket-summary-format ticket)))
(insert (propertize line
'trac-ticket-summary-ticket-id
(trac-ticket-summary-ticket-id ticket))
"\n"))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(run-hooks 'trac-ticket-summary-after-create-hook))
(defun trac-ticket-summary-ticket-id (ticket)
(string-to-number (assoc-default "id" ticket)))
(defun trac-ticket-summary-select ()
"Select a ticket at point."
(interactive)
(let ((ticket-id (get-text-property (line-beginning-position)
'trac-ticket-summary-ticket-id)))
(trac-ticket-ticket trac-ticket-buffer-project
ticket-id)))
(defun trac-ticket-summary-compile-format ()
"Compile `trac-ticket-summary-format'.
Compiled format is set to `trac-ticket-summary-compiled-format'."
(let* ((separator (propertize trac-ticket-summary-separator
'face 'shadow))
(form
`(lambda (ticket)
(format
,(mapconcat (lambda (fmt)
(if (eq (nth 2 fmt) 'right)
(format "%%%ds" (or (nth 1 fmt) 0))
(format "%%-%ds" (or (nth 1 fmt) 0))))
trac-ticket-summary-format
"%s")
,@(subseq
(trac-ticket-flatten
(mapcar
(lambda (fmt)
(list
(if (nth 1 fmt)
`(truncate-string-to-width
(or (assoc-default ,(car fmt) ticket) "")
,(nth 1 fmt))
`(or (assoc-default ,(car fmt) ticket) ""))
separator))
trac-ticket-summary-format))
0 -1)))))
(setq trac-ticket-summary-compiled-format (byte-compile form))))
(defun trac-ticket-summary-format (tickets)
"Format TICKETS."
(funcall trac-ticket-summary-compiled-format tickets))
;;; Cahgelog
;; log := {{time, author, field, oldvalue, newvalue, permanent}, ...}
(defun trac-ticket-log-time (log)
(car log))
(defun trac-ticket-log-author (log)
(nth 1 log))
(defun trac-ticket-log-field (log)
(nth 2 log))
(defun trac-ticket-log-old (log)
(nth 3 log))
(defun trac-ticket-log-new (log)
(nth 4 log))
(defun trac-ticket-log-permanent-p (log)
(= (nth 5 log) 1))
(defun trac-ticket-log-comment-p (log)
(string= (trac-ticket-log-field log) "comment"))
(defun trac-ticket-packedlog-time (log)
(car (car log)))
(defun trac-ticket-packedlog-author (log)
(nth 1 (car log)))
(defun trac-ticket-packedlog-logs (log)
(cdr log))
(defun trac-ticket-log-pack-logs (logs)
"Pack same logs to packed-log in LOGS.
A 'same logs' means same time and same author."
(let (packed-logs)
(dolist (log logs)
(let* ((key (list (trac-ticket-log-time log)
(trac-ticket-log-author log)))
(children (assoc-default key packed-logs)))
(trac-ticket-set-alist 'packed-logs key (cons log children))))
(mapcar (lambda (packed)
(cons (car packed) (nreverse (cdr packed))))
(nreverse packed-logs))))
;;; Ticket
;; log := {id, created, modified, fields}
(defun trac-ticket-ticket-id (ticket)
(car ticket))
(defun trac-ticket-ticket-created (ticket)
(nth 1 ticket))
(defun trac-ticket-ticket-modified (ticket)
(nth 2 ticket))
(defun trac-ticket-ticket-fields (ticket &optional add-extra-p)
"Get fields from ticket.
If ADD-EXTRA-P is non-nil, return value contains values of
`trac-ticket-ticket-extra-field-alist'."
(append (nth 3 ticket)
(and add-extra-p
(mapcar (lambda (cell)
(cons (car cell)
(funcall (cdr cell) ticket)))
trac-ticket-ticket-extra-field-alist))))
(defun trac-ticket-ticket-mode ()
"View ticket mode.
\\{trac-ticket-ticket-mode-map}"
(interactive)
(kill-all-local-variables)
(setq buffer-read-only t)
(use-local-map trac-ticket-ticket-mode-map)
(set-syntax-table trac-ticket-ticket-syntax-table)
(setq major-mode 'trac-ticket-ticket-mode)
(setq mode-name "Trac-Ticket")
(run-hooks 'trac-ticket-ticket-mode-hook))
(defun trac-ticket-ticket-search (project ticket-id)
"Search ticket and log from PROJECT and TICKET-ID.
Return value is a plist that contains :ticket and :packedlogs."
(list :ticket (trac-ticket-rpc-call project 'ticket.get ticket-id)
:packedlogs (trac-ticket-log-pack-logs
(trac-ticket-rpc-call project 'ticket.changeLog ticket-id))))
(defun trac-ticket-ticket (project ticket-id)
"Show ticket from PROJECT and TICKET-ID.
When interactive call, if you are not using trac-ticket yet, this
command asks project of using.
If prefix argument is non-nil, this command asks project always."
(interactive
(list (trac-ticket-read-project current-prefix-arg)
(read-number "Ticket ID: ")))
(switch-to-buffer (format trac-ticket-ticket-buffer-name-format
(trac-ticket-project-name project)
ticket-id))
(trac-ticket-ticket-mode)
(set (make-local-variable 'trac-ticket-buffer-project) project)
(trac-ticket-ticket-create (trac-ticket-get-fields project)
(trac-ticket-ticket-search project ticket-id)))
(defalias 'trac-ticket 'trac-ticket-ticket)
;; 2 column sample
;; (let ((l '(a b c d e f g)))
;; (do ((x l (cddr x)))
;; ((null x))
;; (insert (format "%s-%s\n" (car x) (cadr x)))))
(defun trac-ticket-ticket-create (fields ticket-set)
"Create a ticket buffer from FIELDS and TICKET-SET."
(let* ((inhibit-read-only t)
(field-alist (trac-ticket-field-alist fields))
(ticket (plist-get ticket-set :ticket))
(ticket-fields (trac-ticket-ticket-fields ticket t)))
(erase-buffer)
(insert (propertize
(apply 'format (car trac-ticket-ticket-header-format)
(mapcar (lambda (ticket-field)
(assoc-default ticket-field ticket-fields))
(cdr trac-ticket-ticket-header-format)))
'face 'bold)
"\n")
(dolist (ticket-field (remove-if
(lambda (ticket-field)
(member (car ticket-field)
(cons "description" (cdr trac-ticket-ticket-header-format))))
ticket-fields))
(trac-ticket-ticket-field-insert
(trac-ticket-field-alist-label field-alist (car ticket-field) t)
(or (cdr ticket-field) "")))
(let ((pos (point)))
(insert "\n" (assoc-default "description" ticket-fields)
"\n\n\n")
(trac-ticket-fontify-region pos (point)))
(dolist (packedlog (plist-get ticket-set :packedlogs))
(let ((line (format
"%s - %s\n"
(trac-ticket-format-time (trac-ticket-packedlog-time packedlog))
(trac-ticket-packedlog-author packedlog)))
(logs (trac-ticket-packedlog-logs packedlog)))
(insert (propertize line 'face 'font-lock-comment-face))
(dolist (log (remove-if 'trac-ticket-log-comment-p logs))
(let ((old (trac-ticket-log-old log))
(new (trac-ticket-log-new log)))
(trac-ticket-ticket-field-insert
(trac-ticket-field-alist-label field-alist (trac-ticket-log-field log) t)
(if (or old new)
(format "%s -> %s" (or old "") (or new ""))
"modified"))))
(let ((pos (point)))
(insert
(or (trac-ticket-log-new (find-if 'trac-ticket-log-comment-p logs)) "")
"\n\n")
(trac-ticket-fontify-region pos (point))))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(run-hooks 'trac-ticket-ticket-after-create-hook))
(defun trac-ticket-ticket-field-insert (label value)
(insert (propertize (concat label ":") 'face 'font-lock-keyword-face)
" "
(if (listp value) (mapconcat 'identity value ", ") value)
"\n"))
(defun trac-ticket-ticket-show-ticket-at-point (&optional pos)
"Show ticket at point.
This command understands the following formats:
ticket:N
#N"
(interactive "d")
(setq pos (or pos (point)))
(let ((thing (save-excursion
(goto-char pos)
(thing-at-point 'word))))
(when (string-match "^\\(#\\|ticket:\\)\\([0-9]+\\)" thing)
(trac-ticket-ticket
trac-ticket-buffer-project
(string-to-number (match-string 2 thing))))))
(defun trac-ticket-ticket-buffer-list ()
"Return buffer list limited by ticket mode buffer."
(remove-if (lambda (buf)
(with-current-buffer buf
(not (eq major-mode 'trac-ticket-ticket-mode))))
(buffer-list)))
(defun trac-ticket-ticket-cycle-ticket (&optional previous-p)
"Switch to next ticket buffer.
If PREVIOUS-P is non-nil, it switchs buffer to previously."
(let* ((list (funcall (if previous-p 'nreverse 'identity)
(trac-ticket-ticket-buffer-list)))
(next (or (cadr (member (current-buffer) list))
(car list))))
(unless previous-p
(bury-buffer))
(switch-to-buffer (or next (car list)))))
(defun trac-ticket-ticket-next-ticket ()
"Switch to next ticket buffer."
(interactive)
(trac-ticket-ticket-cycle-ticket))
(defun trac-ticket-ticket-previous-ticket ()
"Switch to previous ticket buffer."
(interactive)
(trac-ticket-ticket-cycle-ticket t))
(defun trac-ticket-ticket-quit ()
"Quit ticket mode.
This function bury all ticket mode buffer."
(interactive)
(dolist (buffer (trac-ticket-ticket-buffer-list))
(bury-buffer buffer))
(bury-buffer))
;;; Utilities
(defun trac-ticket-rpc-call (project method &rest args)
(let ((trac-rpc-endpoint (plist-get project :endpoint)))
(apply 'trac-rpc-call method args)))
(defun trac-ticket-flatten (list)
(apply 'append list))
(defun trac-ticket-set-alist (symbol key value)
(let ((cell (assoc key (symbol-value symbol))))
(if cell
(setcdr cell value)
(set symbol (acons key value (symbol-value symbol))))))
(defun trac-ticket-read-project (&optional force-read)
(if (and (not force-read) trac-ticket-current-project)
trac-ticket-current-project
(let ((project (copy-sequence
(assoc-default
(completing-read "Project: " trac-projects nil t)
trac-projects))))
(setq trac-ticket-current-project project))))
(defun trac-ticket-project-base-url (project)
(replace-regexp-in-string
"\\(/login\\)?/xmlrpc$" "/" (plist-get project :endpoint)))
(defun trac-ticket-project-query-url (project)
(or (plist-get project :query-url)
(url-expand-file-name
"query"
(trac-ticket-project-base-url project))))
(defun trac-ticket-project-name (project)
(or (plist-get project :name)
(file-name-nondirectory
(directory-file-name (trac-ticket-project-base-url project)))))
(defun trac-ticket-get-fields (project)
(let* ((endpoint (plist-get project :endpoint))
(fields (assoc-default endpoint trac-ticket-project-fields)))
(if fields
fields
(setq fields (trac-ticket-rpc-call project 'ticket.getTicketFields))
(setq trac-ticket-project-fields
(acons endpoint fields trac-ticket-project-fields))
fields)))
(defun trac-ticket-float-to-time (n)
(let* ((high (floor (/ n (expt 2 16))))
(low (floor (- n (* (float high) (expt 2 16))))))
(list high low 0)))
(defun trac-ticket-format-time (time)
(when (floatp time)
(setq time (trac-ticket-float-to-time time)))
(format-time-string trac-ticket-time-format time))
(defun trac-ticket-fontify-region (beg end)
(save-excursion
(let ((font-lock-set-defaults t)
(font-lock-keywords trac-wiki-font-lock-keywords))
(font-lock-fontify-keywords-region beg end))))
;; trac-ticket.el ends here
Click here to get the file