diff lisp/efs/efs-report.el @ 22:8fc7fe29b841 r19-15b94

Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 7e54bd776075 8619ce7e4c50
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/efs-report.el	Mon Aug 13 08:50:29 2007 +0200
@@ -0,0 +1,215 @@
+;; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:         efs-report.el
+;; Release:      $efs release: 1.15 $
+;; Version:      $Revision: 1.1 $
+;; RCS:          
+;; Description:  Function to report efs bugs in a usable way.
+;; Author:       Andy Norman, Dawn
+;; Created:      Tue May 18 08:34:45 1993
+;; Modified:     Sun Nov 27 18:41:45 1994 by sandy on gandalf
+;; Language:     Emacs-Lisp
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide 'efs-report)
+(require 'efs)
+(autoload 'reporter-submit-bug-report "reporter")
+(defvar reporter-version) ; For the byte-compiler
+
+;;; Variables
+
+(defconst efs-report-version
+  (concat (substring "$efs release: 1.15 $" 14 -2)
+	  "/"
+	  (substring "$Revision: 1.1 $" 11 -2)))
+
+(defconst efs-report-salutations
+  ["Dear bug team:"
+   "Ciao bug team:"
+   "Salut bug team:"
+   "Gruss bug team:"
+   "To whom it may concern:"
+   "Fellow efs'ers:"
+   "Greetings earthlings:"])
+
+(defvar efs-bug-address "efs-bugs@cuckoo.hpl.hp.com")
+
+(defconst efs-report-other-vars
+  ;; List of variables needed for efs-report, that aren't generated below.
+  '(efs-ftp-program-name
+    efs-ftp-program-args
+    efs-local-host-regexp
+    efs-ftp-local-host-regexp
+    efs-gateway-host
+    efs-gateway-type
+    reporter-version
+    features))
+
+(defconst efs-report-avoid-vars
+  ;; List of variables we don't want to see.
+  '(efs-netrc-filename
+    efs-default-password
+    efs-default-account
+    efs-default-user))
+
+;; Dynamically bound.  Used to pass data to hooks.
+(defvar efs-report-default-host nil)
+(defvar efs-report-default-user nil)
+(defvar efs-report-blurb nil)  
+
+;;; Functions
+
+(defun efs-report-get-host-type-regexps ()
+  "Return a list of host type regexp's which are non-nil."
+  (let ((list efs-host-type-alist)
+	ent result)
+    (while (setq ent (car list))
+      (if (symbol-value (cdr ent))
+	  (setq result (cons (cdr ent) result)))
+      (setq list (cdr list)))
+    result))
+
+(defun efs-report-get-versions ()
+  ;; Return a list of efs versions variables.
+  (mapcar
+   'intern
+   (sort
+    (let (completion-ignore-case)
+      (all-completions
+       "efs-" obarray
+       (function
+	(lambda (sym)
+	  (and (boundp sym)
+	       (let ((name (symbol-name sym)))
+		 (and (>= (length name) 8)
+		      (string-equal (substring name -8) "-version"))))))))
+    'string-lessp)))
+
+(defun efs-report-get-user-vars ()
+  ;; Return a list of efs user variables.
+  (mapcar
+   'intern
+   (sort
+    (let (completion-ignore-case)
+      (all-completions "efs-" obarray 'user-variable-p))
+    'string-lessp)))
+
+(defun efs-report-pre-hook ()
+  ;; efs-report-default-host, efs-report-default-user, and
+  ;; efs-report-blurb are dynamically bound.
+  (save-excursion
+    (let ((end (progn (mail-position-on-field "subject") (point))))
+      (beginning-of-line)
+      (search-forward ":" end)
+      (delete-region (point) end)
+      (insert
+       " EFS "
+       (or (and (boundp 'efs-version) (string-match "/" efs-version)
+		(concat (substring efs-version 0 (match-beginning 0))
+			" "))
+	   "")
+       "bug: ")))
+  (let ((host (read-string "Bug occurred for remote host: "
+			   efs-report-default-host))
+	(user (read-string "Logged in as: "
+			   efs-report-default-user))
+	buff-name)
+    (if (string-match "^ *$" host) (setq host nil))
+    (if (string-match "^ *$" user) (setq user nil))
+    (if host
+	(insert "\nefs believes that the host type of " host " is "
+		(symbol-name (efs-host-type host))
+		".\n"))
+    (if efs-report-blurb
+	(insert "\n" efs-report-blurb "\n"))
+    (if (and host
+	     user
+	     (get-buffer (setq buff-name (efs-ftp-process-buffer host user)))
+	     (save-window-excursion
+	       (y-or-n-p
+		(progn
+		  (with-output-to-temp-buffer "*Help*"
+		    (princ
+		     (format
+		      "The contents of %s
+will likely very useful for identifying any bugs.
+
+You will be given a chance to edit out any sensitive information.
+Passwords are never written into this buffer." buff-name)))
+		  (format "Insert contents of %s? "
+			  buff-name)))))
+	(let ((header-1 (concat "Contents of " buff-name ":"))
+	      (header-2 "Please edit sensitive or irrelevant information."))
+	  (insert "\n" header-1 "\n" header-2 "\n")
+	  (insert-char ?= (max (length header-1) (length header-2)))
+	  (insert "\n\n")
+	  (insert-buffer-substring buff-name)
+	  (insert "\n")))))
+
+(defun efs-report-post-hook ()
+  ;; Post hook run by report-submit-bug-report.
+  (save-excursion
+    (mail-position-on-field "subject")
+    (let ((subj (read-string "Subject header: ")))
+      (if (string-equal subj "")
+	  (subst-char-in-region
+	   (point)
+	   (progn
+	     (insert
+	      (if (or (fboundp 'yow) (load "yow" t t)) (yow) ""))
+	     (point))
+	   ?\n ?\ )
+	(insert subj)))))
+
+(defun efs-report-bug (&optional default-host  default-user blurb no-confirm)
+  "Submit a bug report for efs."
+  (interactive)
+  (let (;; reporter-confirm-p and reporter-package-abbrev appeared once
+	;; as fluid vars in reporter.el.  They aren't used any longer,
+	;; but we let-bind them anyway in case the user has an old version
+	;; of reporter.
+	(reporter-confirm-p nil)
+	(reporter-prompt-for-summary-p nil)
+	(reporter-package-abbrev "efs"))
+    ;; Look out for old reporter versions.
+    (or (boundp 'reporter-version)
+	(setq reporter-version
+	      "Your version of reporter is obsolete.  Please upgrade."))
+    (if (or no-confirm
+	    (y-or-n-p "Do you want to submit a bug report on efs? "))
+	(let ((efs-report-default-host default-host)
+	      (efs-report-default-user default-user)
+	      (efs-report-blurb blurb)
+	      (vars (nconc (efs-report-get-versions)
+			   (efs-report-get-user-vars)
+			   efs-report-other-vars
+			   (efs-report-get-host-type-regexps)))
+	      (avoids efs-report-avoid-vars)
+	      path)
+	  (cond
+	   ((or efs-report-default-host efs-report-default-user))
+	   (efs-process-host
+	    (setq efs-report-default-host efs-process-host
+		  efs-report-default-user efs-process-user))
+	   ((setq path (or buffer-file-name
+			   (and (eq major-mode 'dired-mode)
+				dired-directory)))
+	    (let ((parsed (efs-ftp-path path)))
+	      (setq efs-report-default-host (car parsed)
+		    efs-report-default-user (nth 1 parsed)))))
+	  (while avoids
+	    (setq vars (delq (car avoids) vars))
+	    (setq avoids (cdr avoids)))
+	  (reporter-submit-bug-report
+	   efs-bug-address
+	   "efs"
+	   vars
+	   (function efs-report-pre-hook)
+	   (function efs-report-post-hook)
+	   (aref efs-report-salutations
+		 (% (+ (% (random) 1000) 1000)
+		    (length efs-report-salutations))))))))
+
+;;; end of efs-report.el