cgit.sxemacs.org Git - packages/blob - xemacs-packages/efs/efs-report.el

   1 ;; -*-Emacs-Lisp-*-
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; File:         efs-report.el
   5 ;; Release:      $efs release: 1.24 $
   6 ;; Version:      #Revision: 1.11 $
   7 ;; RCS:
   8 ;; Description:  Function to report efs bugs in a usable way.
   9 ;; Author:       Andy Norman, Dawn
  10 ;; Created:      Tue May 18 08:34:45 1993
  11 ;; Language:     Emacs-Lisp
  12 ;;
  13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14
  15 (provide 'efs-report)
  16 (require 'efs)
  17 (autoload 'reporter-submit-bug-report "reporter")
  18 (defvar reporter-version) ; For the byte-compiler
  19
  20 ;;; Variables
  21
  22 (defconst efs-report-version
  23   (concat (substring "$efs release: 1.24 $" 14 -2)
  24           "/"
  25           (substring "#Revision: 1.10 $" 11 -2)))
  26
  27 (defconst efs-report-salutations
  28   ["Dear bug team:"
  29    "Ciao bug team:"
  30    "Salut bug team:"
  31    "Gruss bug team:"
  32    "To whom it may concern:"
  33    "Fellow efs'ers:"
  34    "Greetings earthlings:"])
  35
  36 (defvar efs-bug-address "elisp-code-efs@nongnu.org")
  37
  38 (defconst efs-report-other-vars
  39   ;; List of variables needed for efs-report, that aren't generated below.
  40   '(efs-ftp-program-name
  41     efs-ftp-program-args
  42     efs-local-host-regexp
  43     efs-ftp-local-host-regexp
  44     efs-gateway-host
  45     efs-gateway-type
  46     reporter-version
  47     features))
  48
  49 (defconst efs-report-avoid-vars
  50   ;; List of variables we don't want to see.
  51   '(efs-netrc-filename
  52     efs-default-password
  53     efs-default-account
  54     efs-default-user))
  55
  56 ;; Dynamically bound.  Used to pass data to hooks.
  57 (defvar efs-report-default-host nil)
  58 (defvar efs-report-default-user nil)
  59 (defvar efs-report-blurb nil)
  60
  61 ;;; Functions
  62
  63 (defun efs-report-get-host-type-regexps ()
  64   "Return a list of host type regexp's which are non-nil."
  65   (let ((list efs-host-type-alist)
  66         ent result)
  67     (while (setq ent (car list))
  68       (if (symbol-value (cdr ent))
  69           (setq result (cons (cdr ent) result)))
  70       (setq list (cdr list)))
  71     result))
  72
  73 (defun efs-report-get-versions ()
  74   ;; Return a list of efs versions variables.
  75   (mapcar
  76    'intern
  77    (sort
  78     (let (completion-ignore-case)
  79       (all-completions
  80        "efs-" obarray
  81        (function
  82         (lambda (sym)
  83           (and (boundp sym)
  84                (let ((name (symbol-name sym)))
  85                  (and (>= (length name) 8)
  86                       (string-equal (substring name -8) "-version"))))))))
  87     'string-lessp)))
  88
  89 (defun efs-report-get-user-vars ()
  90   ;; Return a list of efs user variables.
  91   (mapcar
  92    'intern
  93    (sort
  94     (let (completion-ignore-case)
  95       (all-completions "efs-" obarray 'user-variable-p))
  96     'string-lessp)))
  97
  98 (defun efs-report-pre-hook ()
  99   ;; efs-report-default-host, efs-report-default-user, and
 100   ;; efs-report-blurb are dynamically bound.
 101   (save-excursion
 102     (let ((end (progn (mail-position-on-field "subject") (point))))
 103       (beginning-of-line)
 104       (search-forward ":" end)
 105       (delete-region (point) end)
 106       (insert
 107        " EFS "
 108        (or (and (boundp 'efs-version) (string-match "/" efs-version)
 109                 (concat (substring efs-version 0 (match-beginning 0))
 110                         " "))
 111            "")
 112        "bug: ")))
 113   (let ((host (read-string "Bug occurred for remote host: "
 114                            efs-report-default-host))
 115         (user (read-string "Logged in as: "
 116                            efs-report-default-user))
 117         buff-name)
 118     (if (string-match "^ *$" host) (setq host nil))
 119     (if (string-match "^ *$" user) (setq user nil))
 120     (if host
 121         (insert "\nefs believes that the host type of " host " is "
 122                 (symbol-name (efs-host-type host))
 123                 ".\n"))
 124     (if efs-report-blurb
 125         (insert "\n" efs-report-blurb "\n"))
 126     (if (and host
 127              user
 128              (get-buffer (setq buff-name (efs-ftp-process-buffer host user)))
 129              (save-window-excursion
 130                (y-or-n-p
 131                 (progn
 132                   (with-output-to-temp-buffer "*Help*"
 133                     (princ
 134                      (format
 135                       "The contents of %s
 136 will likely very useful for identifying any bugs.
 137
 138 You will be given a chance to edit out any sensitive information.
 139 Passwords are never written into this buffer." buff-name)))
 140                   (format "Insert contents of %s? "
 141                           buff-name)))))
 142         (let ((header-1 (concat "Contents of " buff-name ":"))
 143               (header-2 "Please edit sensitive or irrelevant information."))
 144           (insert "\n" header-1 "\n" header-2 "\n")
 145           (insert-char ?= (max (length header-1) (length header-2)))
 146           (insert "\n\n")
 147           (insert-buffer-substring buff-name)
 148           (insert "\n")))))
 149
 150 (defun efs-report-post-hook ()
 151   ;; Post hook run by report-submit-bug-report.
 152   (save-excursion
 153     (mail-position-on-field "subject")
 154     (let ((subj (read-string "Subject header: ")))
 155       (if (string-equal subj "")
 156           (subst-char-in-region
 157            (point)
 158            (progn
 159              (insert
 160               (if (or (fboundp 'yow) (load "yow" t t)) (yow) ""))
 161              (point))
 162            ?\n ?\ )
 163         (insert subj)))))
 164
 165 ;;;###autoload
 166 (defun efs-report-bug (&optional default-host  default-user blurb no-confirm)
 167   "Submit a bug report for efs."
 168   (interactive)
 169   (let (;; reporter-confirm-p and reporter-package-abbrev appeared once
 170         ;; as fluid vars in reporter.el.  They aren't used any longer,
 171         ;; but we let-bind them anyway in case the user has an old version
 172         ;; of reporter.
 173         (reporter-confirm-p nil)
 174         (reporter-prompt-for-summary-p nil)
 175         (reporter-package-abbrev "efs"))
 176     ;; Look out for old reporter versions.
 177     (or (boundp 'reporter-version)
 178         (setq reporter-version
 179               "Your version of reporter is obsolete.  Please upgrade."))
 180     (if (or no-confirm
 181             (y-or-n-p "Do you want to submit a bug report on efs? "))
 182         (let ((efs-report-default-host default-host)
 183               (efs-report-default-user default-user)
 184               (efs-report-blurb blurb)
 185               (vars (nconc (efs-report-get-versions)
 186                            (efs-report-get-user-vars)
 187                            efs-report-other-vars
 188                            (efs-report-get-host-type-regexps)))
 189               (avoids efs-report-avoid-vars)
 190               path)
 191           (cond
 192            ((or efs-report-default-host efs-report-default-user))
 193            (efs-process-host
 194             (setq efs-report-default-host efs-process-host
 195                   efs-report-default-user efs-process-user))
 196            ((setq path (or buffer-file-name
 197                            (and (eq major-mode 'dired-mode)
 198                                 dired-directory)))
 199             (let ((parsed (efs-ftp-path path)))
 200               (setq efs-report-default-host (car parsed)
 201                     efs-report-default-user (nth 1 parsed)))))
 202           (while avoids
 203             (setq vars (delq (car avoids) vars))
 204             (setq avoids (cdr avoids)))
 205           (reporter-submit-bug-report
 206            efs-bug-address
 207            "efs"
 208            vars
 209            (function efs-report-pre-hook)
 210            (function efs-report-post-hook)
 211            (aref efs-report-salutations
 212                  (% (+ (% (random) 1000) 1000)
 213                     (length efs-report-salutations))))))))
 214
 215 ;;; end of efs-report.el