tags 422506 patch
thanks
Hello. Here's a patch with an attempt to implement this. The patch also
includes support for displaying the /usr/share/bug/<package>/presubj
file if it exists. This, and executing a potential bug script,
required the debian-bug-package function to be modified quite a bit.
In fact I found it necessary to split out the latter part of it as
a new function, debian-bug-compose-report. This is because the bug
script may require user input, and if so, it is necessary to break out
of the flow and present the user with a buffer for communication with
the bug script. When the bug script terminates however,
debian-bug-compose-report is called to finalize the layout of the
initial contents of the report. Unfortunately, this gets somewhat
unwieldy, but I can't think of a better way to do it. Thus, the
code is somewhat over-commented in places. So feel free to strip
the comments, if that seems better.
Also, a slight change was needed in the debian-bug-filename function,
so it won't insert the name of the file into current buffer, because
after calling debian-bug-package, it's no longer granted that the
current buffer will contain the bug report; it could be the temporary
buffer used for interaction with the bug script process. I've changed
debian-bug-filename to pass the file name as a parameter to
debian-bug-package instead, which will finally be inserted into the
report by debian-bug-compose-report.
I've been testing this a bit, including with emacs21, emacs22 and
xemacs21, and with different MUAs on emacs22, and it seems to work OK.
However, I've limited the testing to the debian-bug function, since
this is mainly where the patch touches the existing code, so hopefully
the patch don't affect other parts of the code. Also, I realize that I
don't have too much Lisp knowledge, so there might be problems I haven't
thought of.
--- a/elisp/debian-el/debian-bug.el 2007-09-25 00:25:00.000000000 +0000
+++ b/elisp/debian-el/debian-bug.el 2008-07-06 22:11:00.000000000 +0000
@@ -647,7 +647,190 @@
(call-process "uname" nil '(t t) nil "-a")
(forward-line -5))))
-(defun debian-bug-package (&optional package)
+(defun debian-bug-help-presubj (package)
+ "Display contents of /usr/share/bug/PACKAGE/presubj."
+ (let ((presubj (concat "/usr/share/bug/" package "/presubj")))
+ (if (file-readable-p presubj)
+ (with-output-to-temp-buffer "*Help*"
+ (with-current-buffer "*Help*"
+ (insert-file-contents presubj))))))
+
+(defun debian-bug-file-is-executable (file)
+ "Return non-nil if FILE is executable. Otherwise nil is returned."
+ (and
+ (file-regular-p file)
+ (string-match "-..x..x..x" (nth 8 (file-attributes file)))))
+
+(defun debian-bug-find-bug-script (package)
+ "Return the full path name of the bug script of PACKAGE, if such
+script exists. Otherwise nil is returned."
+ (let ((script-alt1 (concat "/usr/share/bug/" package "/script"))
+ (script-alt2 (concat "/usr/share/bug/" package)))
+ (cond
+ ((debian-bug-file-is-executable script-alt1) script-alt1)
+ ((debian-bug-file-is-executable script-alt2) script-alt2))))
+
+(defun debian-bug-script-sentinel
+ (process event package severity subject filename
+ bug-script-temp-file win-config)
+ "This function is the process sentinel for bug script processes,'
+and when called, if the process has terminated, this function cleans
+up the buffer used by the process and proceeds to the next step in the
+bug reporting process by calling `debian-bug-compose-report'. Note that
+this process sentinel is different from regular process sentinels in
+that it requires more arguments. So, it cannot be assigned to a process
+with `set-process-sentinel' directly, but requires some tweaking instead."
+ (if (memq (process-status process) '(exit signal))
+ (let* ((bug-script-buffer
+ (process-buffer process))
+ (bug-script-buffer-empty
+ (= (buffer-size bug-script-buffer) 0)))
+
+ ;; Call the process sentinel provided by the term module, to
+ ;; clean up the terminal buffer. The sentinel will print a
+ ;; message in the buffer, so we have been careful to check
+ ;; whether the buffer is empty above, before this call.
+ ;; Note, XEmacs' term module doesn't provide this sentinel.
+ (if (fboundp 'term-sentinel)
+ (term-sentinel process event))
+
+ ;; The reportbug program doesn't seem to care about the exit
+ ;; status of a bug script, so we won't do it either.
+ ;; (if (/= (process-exit-status process) 0)
+ ;; (error (concat "Error occured while collecting"
+ ;; " information about the package")))
+
+ ;; If there is a window displaying the bug script buffer,
+ ;; restore the original window configuration, because it
+ ;; might have been changed when the bug script buffer was
+ ;; displayed. Otherwise, if the buffer isn't visible,
+ ;; assume that the window configuration hasn't changed, so
+ ;; don't restore anything.
+ (if (get-buffer-window bug-script-buffer)
+ (set-window-configuration win-config))
+
+ ;; If the process output buffer still exists, kill it if it's
+ ;; empty, otherwise bury it.
+ (if (buffer-name bug-script-buffer)
+ (if bug-script-buffer-empty
+ (kill-buffer bug-script-buffer)
+ (bury-buffer bug-script-buffer)))
+
+ (debian-bug-compose-report package severity subject filename
+ bug-script-temp-file))))
+
+(defun debian-bug-run-bug-script (package severity subject filename)
+ "Run a script, if provided by PACKAGE, to collect information
+about the package which should be supplied with the bug report,
+and then proceed to the next step in the bug reporting process by
+calling `debian-bug-compose-report'."
+ (let ((handler "/usr/share/reportbug/handle_bugscript")
+ (bug-script (debian-bug-find-bug-script package)))
+ (if (and bug-script
+ (debian-bug-file-is-executable handler)
+ (if (featurep 'xemacs)
+ (or (featurep 'term) (load "term" 'noerror))
+ (require 'term nil 'noerror)))
+ (let ((bug-script-buffer
+ (get-buffer-create "*debian-bug-script*"))
+ (bug-script-temp-file
+ (cond ((fboundp 'make-temp-file) ;; XEmacs doesn't know
+ (make-temp-file "debian-bug-")) ;; make-temp-file.
+ ((fboundp 'temp-directory)
+ (make-temp-name (expand-file-name
+ "debian-bug-" (temp-directory))))
+ (t (error "Cannot create temporary file"))))
+ (bug-script-process)
+
+ ;; XEmacs' term module doesn't set the appropriate
+ ;; coding system for process output from term-exec.
+ ;; Thus the following workaround, otherwise the terminal
+ ;; displayed by XEmacs can get messed up.
+ (coding-system-for-read 'binary))
+
+ (message (concat "Collecting information about the package."
+ " This may take some time."))
+ (with-current-buffer bug-script-buffer
+ (erase-buffer)
+ (term-mode)
+ (term-exec bug-script-buffer "debian-bug-script" handler nil
+ (list bug-script bug-script-temp-file))
+ (setq bug-script-process
+ (get-buffer-process bug-script-buffer))
+
+ ;; The process sentinel should handle process termination.
+ ;; Note that we need to pass more information to the
+ ;; process sentinel than just the process object and event
+ ;; type. Ideally, the process property list seems suitable
+ ;; for this purpose, but that is only supported in GNU
+ ;; Emacs 22 and later. So, a hack is used to construct the
+ ;; process sentinel with the required data on the fly.
+ ;; However, I suspect there are better ways to do this,
+ ;; perhaps to use lexical-let.
+ (set-process-sentinel
+ bug-script-process
+ (list 'lambda '(process event)
+ (list 'debian-bug-script-sentinel 'process 'event
+ package severity subject filename
+ bug-script-temp-file
+ (current-window-configuration))))
+
+ (term-char-mode)
+
+ ;; The function set-process-query-on-exit-flag is only
+ ;; available in GNU Emacs version 22 and later.
+ (if (fboundp 'set-process-query-on-exit-flag)
+ (set-process-query-on-exit-flag bug-script-process nil)))
+
+ ;; Delay switching to the process output buffer by waiting
+ ;; for output from the process, the process to terminate or
+ ;; 200 seconds, because ideally we don't want to display the
+ ;; buffer unless the process will be requesting input, but
+ ;; it's no way to tell that in advance. If the process
+ ;; prints to stdout, it's likely it will be expecting input,
+ ;; so we display the buffer. If the process terminates with
+ ;; no output, we simply don't do anything; the process
+ ;; sentinel will kill the buffer, and proceed, upon process
+ ;; termination.
+ (accept-process-output bug-script-process 200)
+
+ ;; Short wait required here for the process-status to be
+ ;; updated. (Maybe a bug in Emacs?)
+ (sleep-for 0.050)
+ (if (not (memq (process-status bug-script-process)
+ '(exit signal)))
+ (switch-to-buffer-other-window bug-script-buffer)))
+
+ (debian-bug-compose-report package severity subject filename))))
+
+(defun debian-bug-insert-bug-script-temp-file (temp-file)
+ "Insert the output from the bug script, if any, into the current
+buffer in the appropriate place."
+ (when (and temp-file (file-readable-p temp-file))
+ (save-excursion
+ (next-line 1)
+ (insert "\n")
+ (insert "-- Package-specific info:\n")
+ (let ((beg (point))
+ (end (+ (point)
+ (nth 1 (insert-file-contents temp-file)))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-max))
+ (beginning-of-line)
+ (when (not (looking-at "$"))
+ (end-of-line)
+ (insert "\n"))
+ (when (and (boundp 'mml-mode) mml-mode)
+ (mml-quote-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert "<#part type=\"text/plain\" disposition=inline"
+ " description=\"Bug script output\">\n")
+ (goto-char (point-max))
+ (insert "<#/part>\n"))))
+ (delete-file temp-file))))
+
+(defun debian-bug-package (&optional package filename)
"Submit a Debian bug report about PACKAGE."
(if (or (not package) (string= "" package))
(save-window-excursion
@@ -674,50 +857,63 @@
(completing-read "Severity (default normal): "
debian-bug-severity-alist
nil t nil nil "normal")))
- (subject (read-string "(Very) brief summary of problem: ")))
-;;; (require 'reporter)
- (reporter-compose-outgoing)
- (if (and (equal mail-user-agent 'gnus-user-agent)
- (string-equal " *nntpd*" (buffer-name)))
- (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*"
- (goto-char (point-min))
- (when (re-search-forward "^cc:" nil t)
- (delete-region (match-beginning 0)(match-end 0))
- (insert "X-Debbugs-CC:"))
- (goto-char (point-min))
- (cond
- ((re-search-forward "To: " nil t)
- (insert debian-bug-mail-address))
- ((re-search-forward "To:" nil t)
- (insert " " debian-bug-mail-address))
- (t
- (insert "To: " debian-bug-mail-address)))
- (if (string-equal severity "minor")
- (debian-bug--set-bts-address "[EMAIL PROTECTED]"))
- (goto-char (point-min))
- (cond
- ((re-search-forward "Subject: " nil t)
- (insert package ": " subject))
- ((re-search-forward "Subject:" nil t)
- (insert " " package ": " subject))
- (t
- (insert "Subject: " package ": " subject)))
- (require 'sendmail)
- (goto-char (mail-header-end))
- (forward-line 1)
- (if (looking-at "^<#secure") ;Skip over mml directives
- (forward-line 1))
- (message "Getting package information from reportbug...")
- (debian-bug-prefill-report package severity)
- (message "Getting package information from reportbug...done")
- (if debian-bug-use-From-address
- (debian-bug--set-custom-From))
- (if debian-bug-always-CC-myself
- (debian-bug--set-CC debian-bug-From-address "X-Debbugs-CC:"))
- (set-window-start (selected-window) (point-min) t)
- (setq debian-bug-package-name package)
- (debian-bug-minor-mode 1)
- (set-buffer-modified-p nil))))
+ (subject (save-window-excursion
+ (debian-bug-help-presubj package)
+ (read-string "(Very) brief summary of problem: "))))
+ (debian-bug-run-bug-script package severity subject filename))))
+
+(defun debian-bug-compose-report
+ (package severity subject filename &optional bug-script-temp-file)
+"Compose the initial contents of the bug report and present it in
+a buffer to be completed by the user."
+;;; (require 'reporter)
+ (reporter-compose-outgoing)
+ (if (and (equal mail-user-agent 'gnus-user-agent)
+ (string-equal " *nntpd*" (buffer-name)))
+ (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*"
+ (goto-char (point-min))
+ (when (re-search-forward "^cc:" nil t)
+ (delete-region (match-beginning 0)(match-end 0))
+ (insert "X-Debbugs-CC:"))
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "To: " nil t)
+ (insert debian-bug-mail-address))
+ ((re-search-forward "To:" nil t)
+ (insert " " debian-bug-mail-address))
+ (t
+ (insert "To: " debian-bug-mail-address)))
+ (if (string-equal severity "minor")
+ (debian-bug--set-bts-address "[EMAIL PROTECTED]"))
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "Subject: " nil t)
+ (insert package ": " subject))
+ ((re-search-forward "Subject:" nil t)
+ (insert " " package ": " subject))
+ (t
+ (insert "Subject: " package ": " subject)))
+ (require 'sendmail)
+ (goto-char (mail-header-end))
+ (forward-line 1)
+ (if (looking-at "^<#secure") ;Skip over mml directives
+ (forward-line 1))
+ (message "Getting package information from reportbug...")
+ (debian-bug-prefill-report package severity)
+ (message "Getting package information from reportbug...done")
+ (if debian-bug-use-From-address
+ (debian-bug--set-custom-From))
+ (if debian-bug-always-CC-myself
+ (debian-bug--set-CC debian-bug-From-address "X-Debbugs-CC:"))
+ (when filename
+ (forward-char -1)
+ (insert "File: " filename "\n")
+ (forward-char 1))
+ (debian-bug-insert-bug-script-temp-file bug-script-temp-file)
+ (set-window-start (selected-window) (point-min) t)
+ (setq debian-bug-package-name package)
+ (debian-bug-minor-mode 1)
+ (set-buffer-modified-p nil))
;;; ---------
;;; WNPP interface by Peter S Galbraith <[EMAIL PROTECTED]>, August 4th 2001
@@ -2012,10 +2208,7 @@
(let ((answer (y-or-n-p (format "File is in package %s; continue? "
package))))
(when answer
- (debian-bug-package package)
- (save-excursion
- (forward-char -1)
- (insert "File: " filename "\n"))))))))))
+ (debian-bug-package package filename)))))))))
;;;###autoload
(defun debian-bug ()
