-
Notifications
You must be signed in to change notification settings - Fork 11
/
hib-debbugs.el
296 lines (270 loc) · 12.8 KB
/
hib-debbugs.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
;;; hib-debbugs.el --- Implicit button type for browsing GNU debbugs issues. -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Jun-16 at 14:24:53
;; Last-Mod: 30-Jun-24 at 03:16:07 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 2016-2024 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of Hyperbole. It requires the Emacs package
;; debbugs-gnu 0.9.7 or higher; there were bugs in earlier versions
;; that made it incompatible with the queries Hyperbole issues.
;;
;;; Commentary:
;;
;; NOTE: Although Emacs now comes with the library "bug-reference-mode.el"
;; which displays bug numbers, this library provides a much broader
;; set of facilities and is activated via the Smart Keys, so no
;; new key bindings are necessary.
;;
;; Debbugs is a client-server issue tracker used by Gnu projects
;; to manage issues and maintain threads of discussion around them.
;;
;; This does nothing unless the third-party Emacs package debbugs
;; 0.9.7 or higher is installed. Once it is installed
;; and Hyperbole is loaded, the Smart Keys will generate debbugs
;; queries when pressed within any of the following buffer text
;; formats (with point prior to any attribute):
;;
;; bug#id-number, bug# id-number, bug #id-number, or bug id-number
;; bug?attr1=val1&attr2=val2&attr3=val3
;; bug#id-number?attr1=val1&attr2=val2&attr3=val3
;;
;; where the attr and val fields are sent as part of the debbugs query.
;; Note that `issue' or `debbugs' may be used as well in place of `bug'.
;;
;; A press of the Action Key on a Gnu debbugs string, will generate
;; a debbugs query and display the result. If the string represents a
;; single debbugs id, Hyperbole will display the original submission
;; message for that issue and will allow further browsing of the
;; discussion.
;;
;; A press of the Assist Key on a Gnu debbugs id, displays the subject
;; and current status of the issue. When within another type of Gnu
;; debbugs query, it shows standard Hyperbole button help for the query.
;;
;; Additionally, two query functions are provided:
;;
;; (debbugs-gnu-query:list query-attribute-list) displays issues
;; matching the set of (attribute . attribute-value) pairs in its argument.
;;
;; For example:
;; (debbugs-gnu-query:list '((status . "open") (package . "hyperbole")))
;; (debbugs-gnu-query:list '((package . "hyperbole") (severity . "normal")))
;;
;; (debbugs-gnu-query:string url-query-string) parses and applies
;; attributes from a string of the form:
;; bug[#id-number]?attr1=val1&attr2=val2&attr3=val3
;; and uses it to display matching issues.
;;
;; For example:
;; (debbugs-gnu-query:string "bug?package=hyperbole&status=open")
;; (debbugs-gnu-query:string "package=hyperbole&severity=normal")
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(eval-and-compile (mapc #'require '(hactypes)))
(eval-when-compile (require 'debbugs-gnu nil t))
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(declare-function debbugs-get-status "ext:debbugs-gnu")
(declare-function debbugs-gnu-bugs "ext:debbugs-gnu")
(declare-function debbugs-gnu-current-id "ext:debbugs-gnu")
(declare-function debbugs-gnu-select-report "ext:debbugs-gnu")
(declare-function debbugs-gnu-show-reports "ext:debbugs-gnu")
(defvar debbugs-gnu-current-query)
(defvar debbugs-port)
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(eval-after-load "debbugs-gnu"
'(progn
(defvar debbugs-gnu-all-packages)
(push "hyperbole" debbugs-gnu-all-packages)
(push "oo-browser" debbugs-gnu-all-packages)))
;;; ************************************************************************
;;; Public implicit button types
;;; ************************************************************************
(defib debbugs-gnu-query ()
"Display the results of a Debbugs query from a bug reference string around point.
This works in most types of buffers. If the query includes a
single id number, display the original message submission for
that id and allow browsing of the followup discussion. Accepts
the following buffer text formats (with point prior to any
attribute):
bug#id-number or bug# id-number or bug #id-number
bug?attr1=val1&attr2=val2&attr3=val3
bug#id-number?attr1=val1&attr2=val2&attr3=val3
Note that `issue' or `debbugs' may be used as well in place of `bug'."
(when (debbugs-version-sufficient-p)
(when (debbugs-query:at-p)
(ibut:label-set (buffer-substring-no-properties
(match-beginning 1) (match-end 2))
(match-beginning 1)
(match-end 2))
(if (and (match-beginning 3) (string-equal "?" (match-string 3)))
(hact 'debbugs-gnu-query:string (buffer-substring-no-properties
(or (match-beginning 1) (match-beginning 2))
(match-end 4)))
(hact 'debbugs-gnu-query (string-to-number (match-string 2)))))))
(defact debbugs-gnu-query (id)
"Display the discussion of Gnu debbugs ID (a positive integer)."
(require 'debbugs-gnu)
(when (debbugs-get-status id)
(debbugs-gnu-bugs id)
(debbugs-gnu-show-discussion)))
(defun debbugs-gnu-query:help (_but)
"Make a Gnu debbugs id number at point display the pretty-printed bug status.
The id number can optionally be prefixed with a # sign.
Ignore other types of GNU debbugs query strings."
(if (and (debbugs-version-sufficient-p)
(debbugs-query:at-p)
(match-beginning 2))
(debbugs-query:status (string-to-number (match-string 2)))
;; Non-single issue query, show standard button help.
(hkey-help t)))
(defib debbugs-gnu-mode ()
"Make a Gnu Debbugs listing entry at point display the discussion on the issue."
(when (eq major-mode 'debbugs-gnu-mode)
(ibut:label-set (buffer-substring-no-properties
(line-beginning-position) (line-end-position))
(line-beginning-position) (line-end-position))
(hact 'smart-debbugs-gnu)))
(defun debbugs-gnu-mode:help (&optional _but)
"Make a Gnu debbugs listing at point pretty-print its status to a window below."
(ignore-errors
(let ((display-buffer-overriding-action
'(display-buffer-below-selected . nil)))
(debbugs-query:status (debbugs-gnu-current-id))
(hypb:maximize-window-height))))
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
(defun debbugs-gnu-show-discussion ()
"Display the 2nd message which is the initial bug report.
This may be in Gnus or Rmail summary mode."
(debbugs-gnu-select-report)
(goto-char (point-min))
(forward-line 1)
(call-interactively (key-binding "\C-m")))
(defun debbugs-gnu-query:string (url-query-string)
"Show the results of a Gnu debbugs query with attributes from URL-QUERY-STRING.
URL-QUERY-STRING must be a valid URL query string (part after the
question mark) of debbugs attributes and values,
i.e. \"attr1=val1&attr2=val2&attr3=val3\" URL encoded characters
are decoded. An optional prefix of \"bug#<id-number>?\" may also
be included at the front of the string to limit the query to a
particular issue number. Note that `issue' or `debbugs' may be
used as well in place of `bug'."
(let* ((case-fold-search t)
(id (when (string-match "\\`\\(bug\\|debbugs\\|issue\\)\\s-?#?\\s-?\\(\\([1-9][0-9]*\\)\\|\\?\\)+"
url-query-string)
(prog1 (match-string 3 url-query-string)
(setq url-query-string (substring url-query-string (match-end 0))))))
attr-pair-list)
;; Change elements from lists to cons pairs.
(setq attr-pair-list
(mapcar (lambda (elt) (cons (car elt) (cadr elt)))
(url-parse-query-string url-query-string))) ;; autoloaded
(when id
(push (cons 'bugs (list (string-to-number id))) attr-pair-list))
(debbugs-gnu-query:list attr-pair-list)))
(defun debbugs-gnu-query:list (query-attribute-list)
"Show the results of a Gnu debbugs query with QUERY-ATTRIBUTE-LIST attributes.
Each element of the list should be of the form (attribute . attribute-value).
Attribute may be a symbol or a string. Common attributes
include: status, severity, and package."
(require 'debbugs)
(setq debbugs-gnu-current-query nil)
(dolist (attr query-attribute-list)
(add-to-list 'debbugs-gnu-current-query
(cons (if (symbolp (car attr))
(car attr)
(intern (car attr)))
(cdr attr))))
(debbugs-gnu-show-reports))
(defun smart-debbugs-gnu ()
"Display the discussion on the issue at point.
When the Action Key is pressed on a Gnu Debbugs listing entry."
(debbugs-gnu-show-discussion))
;; (let ((entries (cdar tabulated-list-entries)))
;; (cond ((= (length entries) 1)
;; (hact 'debbugs-gnu-query
;; (string-to-number (aref (nth (1- (line-number-at-pos (point))) entries) 0))))))
;; Each listed entry can be retrieved as a list of dotted pair attributes with:
;; (tabulated-list-get-id (point))
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
(defun debbugs-query:at-p ()
"Return t if point appears to be within a debbugs id.
Id number is (match-string 2). If this is a query with attributes,
then (match-string 3) = \"?\" and (match-string 4) is the query
attributes."
;; Point must be before one of the bug#222 characters to match.
(let ((case-fold-search t))
(when (string-match "[bugise#0-9]" (char-to-string (following-char)))
(save-excursion
(skip-chars-backward "#0-9")
(skip-chars-backward " \t\n\r\f")
(skip-chars-backward "bugdiseBUGDISE#") ;; bug, debbugs or issue
;; Allow for bug#222?package=hyperbole&severity=high as well as bug222, or bug#222.
(or (looking-at "[ \t\n\r\f]*\\(bug#?\\|debbugs#?\\|issue#?\\)[ \t\n\r\f]*#?\\([1-9][0-9]*\\)?\\(\\?\\)\\([a-z=&0-9%;()]+\\)")
(looking-at "[ \t\n\r\f]*\\(bug#?\\|debbugs#?\\|issue#?\\)[ \t\n\r\f]*#?\\([1-9][0-9]*\\)[\].,;?:!\)\>\}]?\\([ \t\n\r\f]\\|\\'\\)"))))))
;; Ignore matches like #222, so this is not confused with "hib-social.el" social references.
;; (looking-at "[ \t\n\r\f]*\\(bug\\|debbugs\\|issue\\)?[ \t\n\r\f]*#\\([1-9][0-9]*\\)[\].,;?!\)\>\}]?\\([ \t\n\r\f]\\|\\'\\)")
(defun debbugs-query:status (id)
"Pretty print to `standard-output' the status attributes of debbugs ID.
Debbugs ID is a positive integer. Ignore nil valued attributes.
Return t unless no attributes are printed."
(require 'debbugs-gnu)
;; The (car (debbugs-get-status id)) is a list of (attribute . value) pairs which we sort below.
(let ((attrib-list
(sort (delq nil (mapcar (lambda (elt) (when (cdr elt) elt)) (car (debbugs-get-status id))))
(lambda (a b) (string-lessp (car a) (car b)))))
(has-attr) attr len val)
(unless (or (null attrib-list) (not (listp attrib-list)))
(with-help-window "*Debbugs Help*"
(princ (format "Status of %s %s package issue #%d (%s):\n"
(capitalize (substring debbugs-port 0 (string-match "\\." debbugs-port)))
(or (cadr (assq 'package attrib-list)) "")
id
(or (cdr (assq 'subject attrib-list)) "no subject")))
(while (setq attr (car (car attrib-list)))
(setq val (cdr (car attrib-list))
attrib-list (cdr attrib-list))
(when val
(setq has-attr t
len (number-to-string (max (- 16 (length (symbol-name attr))) 1)))
(princ (format (concat " %s:%" len "s%S\n") attr " " val))))
has-attr))))
(defun debbugs-version-sufficient-p ()
"Return t iff debbugs version is sufficient for use with Hyperbole.
Must be greater than equal to 0.9.7."
(save-excursion
(let* ((debbugs-src (or (locate-file "debbugs" load-path '(".el"))
(locate-file "debbugs-gnu" load-path '(".el"))))
(visiting-debbugs-src (when debbugs-src (get-file-buffer debbugs-src)))
debbugs-src-buffer
version)
(when debbugs-src
(unwind-protect
(if (string-match "debbugs-\\([0-9]+.[0-9]+\\(.[0-9]+\\)?\\)" debbugs-src)
(setq version (match-string 1 debbugs-src))
(set-buffer (setq debbugs-src-buffer (find-file-noselect debbugs-src)))
(widen)
(goto-char (point-min))
(when (re-search-forward "^;; Version: \\([.0-9]+\\)" nil t)
(setq version (match-string 1))))
(unless (or visiting-debbugs-src (null debbugs-src-buffer))
(kill-buffer debbugs-src-buffer)))
(when (and version (not (equal version "")))
(version-list-<= (version-to-list "0.9.7") (version-to-list version)))))))
(provide 'hib-debbugs)
;;; hib-debbugs.el ends here