(defface debbugs-done '((t (:foreground "DarkGrey")))
"Face for closed bug reports.")
+(defvar debbugs-widget-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'widget-button-press)
+ map))
+
(defun debbugs-emacs (severities &optional package suppress-done archivedp)
"List all outstanding Emacs bugs."
(interactive
:follow-link 'mouse-face
:notify (lambda (widget &rest ignore)
(debbugs-show-reports
+ (widget-get widget :suppress-done)
widget
- (widget-get widget :debbugs-widgets)))
- :debbugs-suppress-done suppress-done
- :debbugs-buffer-name (format "*Emacs Bugs*<%d>" i)
- :debbugs-ids curr-ids
- :help-echo (format
- "%d-%d"
- (car ids) (car (last curr-ids)))
- :format " %[%v%]"
- (number-to-string i))))
+ (widget-get widget :widgets)))
+ :keymap debbugs-widget-map
+ :suppress-done suppress-done
+ :buffer-name (format "*Emacs Bugs*<%d>" i)
+ :bug-ids (butlast ids (- (length ids) default))
+ (format " %d" i))))
ids (last ids (- (length ids) default))))
- (debbugs-show-reports (car widgets) widgets))
+ (debbugs-show-reports suppress-done (car widgets) widgets))
- (debbugs-show-reports (widget-convert
+ (debbugs-show-reports suppress-done
+ (widget-convert
'const
- :debbugs-suppress-done suppress-done
- :debbugs-buffer-name "*Emacs Bugs*"
- :debbugs-ids ids)
+ :buffer-name "*Emacs Bugs*"
+ :bug-ids ids)
nil))))
-(defun debbugs-widget-format-handler (widget escape)
- (cond
- ;; That's the only format we support.
- ((eq escape ?f)
- (let ((size (widget-get widget :debbugs-size))
- (string (format (widget-get widget :debbugs-format)
- (widget-value widget))))
- (insert
- (cond
- ((and (numberp size) (> (length string) size))
- (propertize (substring string 0 size) 'help-echo string))
- ((numberp size) string)
- (t (propertize string 'help-echo string))))))
- ;; Error handling.
- (t
- (widget-default-format-handler widget escape))))
-
-(defun debbugs-show-reports (widget widgets)
- "Show bug reports as given in WIDGET property :debbugs-ids."
- (pop-to-buffer (get-buffer-create (widget-get widget :debbugs-buffer-name)))
+(defun debbugs-show-reports (suppress-done widget widgets)
+ "Show bug reports as given in WIDGET property :bug-ids."
+ (pop-to-buffer (get-buffer-create (widget-get widget :buffer-name)))
(debbugs-mode)
- (let ((suppress-done (widget-get widget :debbugs-suppress-done)))
+ (let ((inhibit-read-only t))
(erase-buffer)
(when widgets
(widget-insert "Page:")
(mapc
(lambda (obj)
- (widget-put obj :debbugs-widgets widgets)
- (widget-put obj :button-face
- (if (eq obj widget)
- 'widget-button-pressed
- 'widget-button-face))
+ (widget-insert " ")
+ (widget-put obj :widgets widgets)
+ (if (eq obj widget)
+ (widget-put obj :button-face 'widget-button-pressed)
+ (widget-put obj :button-face 'widget-button-face))
(widget-apply obj :create))
widgets)
(widget-insert "\n\n"))
(dolist (status (sort (apply 'debbugs-get-status
- (widget-get widget :debbugs-ids))
+ (widget-get widget :bug-ids))
(lambda (s1 s2)
(< (cdr (assq 'id s1))
(cdr (assq 'id s2))))))
(when (or (not suppress-done)
(not (equal (cdr (assq 'pending status)) "done")))
- (let ((id (cdr (assq 'id status)))
- (face
- (cond
- ((equal (cdr (assq 'pending status)) "done")
- 'debbugs-done)
- ((= (cdr (assq 'date status))
- (cdr (assq 'log_modified status)))
- 'debbugs-new)
- ((< (- (float-time)
- (cdr (assq 'log_modified status)))
- (* 60 60 24 4))
- 'debbugs-handled)
- (t
- 'debbugs-stale)))
- (words
- (mapconcat
- 'identity
- (cons (cdr (assq 'severity status))
- (cdr (assq 'keywords status)))
- ","))
- (address (mail-header-parse-address
+ (let ((address (mail-header-parse-address
(decode-coding-string (cdr (assq 'originator status))
'utf-8)))
(subject (decode-coding-string (cdr (assq 'subject status))
'utf-8))
merged)
- (unless (equal (cdr (assq 'pending status)) "pending")
- (setq words
- (concat words "," (cdr (assq 'pending status)))))
- (when (setq merged (cdr (assq 'mergedwith status)))
- (setq words (format "%s,%s"
- (if (numberp merged)
- merged
- (mapconcat 'number-to-string merged ","))
- words)))
(setq address
;; Prefer the name over the address.
(or (cdr address)
(car address)))
-
- (widget-create 'const
- :format "%f"
- :debbugs-format "%5d"
- :debbugs-size 5
- :debbugs-status status
- :format-handler 'debbugs-widget-format-handler
- id)
-
- (widget-create 'const
- :format " %{%f%}"
- :debbugs-format "%-20s"
- :debbugs-size 20
- :format-handler 'debbugs-widget-format-handler
- :sample-face face
- words)
-
- (widget-create 'const
- :format " [%f]"
- :debbugs-format "%-23s"
- :debbugs-size 23
- :format-handler 'debbugs-widget-format-handler
- address)
-
- (let ((widget-link-prefix "")
- (widget-link-suffix ""))
- (widget-create 'link
- :format " %[%v%]\n"
- :debbugs-id id
- :follow-link 'mouse-face
- :notify (lambda (widget &rest ignore)
- (debbugs-select-report
- (widget-get widget :debbugs-id)))
- :help-echo subject
- subject)))))
+ (insert
+ (format "%5d %-20s [%-23s] %s\n"
+ (cdr (assq 'id status))
+ (let ((words
+ (mapconcat
+ 'identity
+ (cons (cdr (assq 'severity status))
+ (cdr (assq 'keywords status)))
+ ",")))
+ (unless (equal (cdr (assq 'pending status)) "pending")
+ (setq words
+ (concat words "," (cdr (assq 'pending status)))))
+ (when (setq merged (cdr (assq 'mergedwith status)))
+ (setq words (format "%s,%s"
+ (if (numberp merged)
+ merged
+ (mapconcat 'number-to-string merged
+ ","))
+ words)))
+ (if (> (length words) 20)
+ (propertize (substring words 0 20) 'help-echo words)
+ words))
+ (if (> (length address) 23)
+ (propertize (substring address 0 23) 'help-echo address)
+ address)
+ (propertize subject 'help-echo subject)))
+ (forward-line -1)
+ (put-text-property (point) (1+ (point))
+ 'debbugs-status status)
+ (put-text-property
+ (+ (point) 5) (+ (point) 26)
+ 'face
+ (cond
+ ((equal (cdr (assq 'pending status)) "done")
+ 'debbugs-done)
+ ((= (cdr (assq 'date status))
+ (cdr (assq 'log_modified status)))
+ 'debbugs-new)
+ ((< (- (float-time)
+ (cdr (assq 'log_modified status)))
+ (* 60 60 24 4))
+ 'debbugs-handled)
+ (t
+ 'debbugs-stale)))
+ (forward-line 1))))
(when widgets
(widget-insert "\nPage:")
- (mapc (lambda (obj) (widget-apply obj :create)) widgets))
+ (mapc
+ (lambda (obj)
+ (widget-insert " ")
+ (widget-put obj :widgets widgets)
+ (if (eq obj widget)
+ (widget-put obj :button-face 'widget-button-pressed)
+ (widget-put obj :button-face 'widget-button-face))
+ (widget-apply obj :create))
+ widgets)
+ (widget-setup))
- (widget-setup)
- (set-buffer-modified-p nil)
(goto-char (point-min))))
(defvar debbugs-mode-map
- (let ((map (copy-keymap special-mode-map)))
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'debbugs-select-report)
(define-key map "q" 'kill-buffer)
(define-key map "s" 'debbugs-toggle-sort)
- (set-keymap-parent map widget-keymap)
+ (define-key map "d" 'debbugs-display-status)
map))
(defvar debbugs-sort-state 'number)
(interactive)
(beginning-of-line)
(let ((buffer-read-only nil)
- (current-bug (and (not (eobp))
- (buffer-substring (point) (+ (point) 5)))))
- (goto-char (point-min))
+ (before-change-functions nil)
+ (current-bug (debbugs-current-id t)))
(setq debbugs-sort-state
(if (eq debbugs-sort-state 'number)
'state
'number))
- (sort-subr
- nil (lambda () (forward-line 1)) 'end-of-line
- (lambda ()
- (if (eq debbugs-sort-state 'number)
- (string-to-number (buffer-substring (point) (+ (point) 5)))
- (or (cdr (assq (get-text-property (+ (point) 7) 'face)
- debbugs-state-preference))
- 10))))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (not (get-text-property (point) 'debbugs-status)))
+ (forward-line 1))
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (progn
+ (goto-char (point-max))
+ (beginning-of-line)
+ (while (and (not (bobp))
+ (not (get-text-property (point) 'debbugs-status)))
+ (forward-line -1))
+ (forward-line 1)
+ (point)))
+ (goto-char (point-min))
+ (sort-subr
+ nil (lambda () (forward-line 1)) 'end-of-line
+ (lambda ()
+ (if (eq debbugs-sort-state 'number)
+ (debbugs-current-id)
+ (or (cdr (assq (get-text-property (+ (point) 7) 'face)
+ debbugs-state-preference))
+ 10)))))
(if (not current-bug)
(goto-char (point-max))
(goto-char (point-min))
- (re-search-forward (concat "^" current-bug) nil t))))
+ (re-search-forward (format "^%d" current-bug) nil t))))
(defvar debbugs-bug-number nil)
+(defun debbugs-current-id (&optional noerror)
+ (or (cdr (assq 'id (get-text-property (line-beginning-position)
+ 'debbugs-status)))
+ (and (not noerror)
+ (error "No bug on the current line"))))
+
+(defun debbugs-display-status (id)
+ "Display the status of the report on the current line."
+ (interactive (list (debbugs-current-id)))
+ (let ((status (get-text-property (line-beginning-position)
+ 'debbugs-status)))
+ (pop-to-buffer "*Bug Status*")
+ (erase-buffer)
+ (pp status (current-buffer))
+ (goto-char (point-min))))
+
(defun debbugs-select-report (id)
- "Select the report for ID."
- (interactive)
+ "Select the report on the current line."
+ (interactive (list (debbugs-current-id)))
+ ;; We open the report messages.
(gnus-read-ephemeral-emacs-bug-group
id (cons (current-buffer)
(current-window-configuration)))