cgit.sxemacs.org Git - slh/blob - ges-post.el

   1 ;;; ges-post.el --- post elisp files to gnu.emacs.sources using Gnus
   2
   3 ;; Copyright (C) 2004 Michael Schierl
   4 ;; Copyright (C) 2004 Steve Youngs
   5
   6 ;; RCS: $Id: ges-post.el,v 0.6 2004-03-21 11:56:13+10 steve Exp $
   7 ;; Author:        Michael Schierl <schierlm-public@gmx.de>
   8 ;;                Steve Youngs <sryoungs@bigpond.net.au>
   9 ;; Maintainer:    Steve Youngs <sryoungs@bigpond.net.au>
  10 ;; Created:       <2004-03-14>
  11 ;; Last-Modified: <2004-03-21 11:50:28 (steve)>
  12 ;; Homepage:      None.  Contact maintainer for the latest version.
  13 ;; Keywords:      gnu.emacs.sources posting Gnus news
  14 ;; Version:       $Revision: 0.6 $
  15
  16 ;; Redistribution and use in source and binary forms, with or without
  17 ;; modification, are permitted provided that the following conditions
  18 ;; are met:
  19 ;;
  20 ;; 1. Redistributions of source code must retain the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer.
  22 ;;
  23 ;; 2. Redistributions in binary form must reproduce the above copyright
  24 ;;    notice, this list of conditions and the following disclaimer in the
  25 ;;    documentation and/or other materials provided with the distribution.
  26 ;;
  27 ;; 3. Neither the name of the author nor the names of any contributors
  28 ;;    may be used to endorse or promote products derived from this
  29 ;;    software without specific prior written permission.
  30 ;;
  31 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  32 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  33 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  34 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  35 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  36 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  37 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  38 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  39 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  40 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  41 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  42
  43 ;;; Commentary:
  44 ;;
  45 ;; gnu.emacs.sources is a newsgroup to post Elisp sources to. Since
  46 ;; the job of creating such postings is quite repetitive, Emacs can
  47 ;; help you with it. After having loaded the source file just type M-x
  48 ;; ges-post-current-buffer RET and a Gnus message buffer will be
  49 ;; prepared for you containing the full source and a default subject
  50 ;; (file name, version number (if detectable) and summary line). You
  51 ;; will be asked for a group (just hit RET for gnu.emacs.sources) and
  52 ;; whether you want to send the article directly. Otherwise point is
  53 ;; placed before the first line, so you can easily add a comment there
  54 ;; if you want to.
  55
  56 ;; you can customize `ges-post-use-mime' to send files as a MIME
  57 ;; attachment (default is no for backwards compatibility) or
  58 ;; `ges-post-gnus-plugged' if you want to start Gnus unplugged when it
  59 ;; is not started yet.
  60
  61 ;;; History:
  62 ;; $Log: ges-post.el,v $
  63 ;; Revision 0.6  2004-03-21 11:56:13+10  steve
  64 ;; Fix a couple of bytecompiler warnings.
  65 ;;
  66 ;; Revision 0.5  2004-03-21 11:40:42+10  steve
  67 ;; First release by Steve Youngs
  68 ;;
  69 ;;   Version 0.4 was Michael's final release as maintainer.  From
  70 ;;   this point on Steve Youngs is maintaining ges-post.
  71 ;;
  72 ;;   - Switch to BSD license.
  73 ;;   - Set a Followup-To header.
  74 ;;   - Add `ges-post-file'.
  75 ;;   - A few cosmetic changes.
  76
  77 ;; 2004-03-19 Suggestion by Reiner Steib <reiner.steib@gmx.de>
  78 ;;   - Moved defgroup "ges-post" below "gnus-message"
  79
  80 ;; 2004-03-17 Patch by Steve Youngs <sryoungs@bigpond.net.au>
  81 ;;   - Added a defgroup "ges-post", a subgroup of "gnus-fun".
  82 ;;   - Made the defcustoms use it
  83 ;;   - Added a keybinding
  84 ;;   - Added a convenience alias `ges-post -> ges-post-current-buffer'
  85 ;;   - Added an autoload so that entering emacs-lisp-mode will load ges-post
  86 ;;   - I figure there's no harm in a bit of advertising...
  87
  88 ;; 2004-03-16 Patch by Steve Youngs <sryoungs@bigpond.net.au>:
  89 ;;   - start Gnus automatically if needed
  90 ;;   - ask for group name
  91 ;;   - use lisp-mnt functions to determine summary and version
  92 ;;   - optionally post as a MIME attachment
  93 ;;   - send article automatically if desired
  94
  95 ;; 2004-03-14 First "release" in gnu.emacs.sources
  96
  97 ;;; Code:
  98
  99 (require 'gnus-msg)
 100 (require 'lisp-mnt)
 101
 102 (eval-when-compile
 103   (autoload 'with-electric-help "ehelp")
 104   (autoload 'font-lock-fontify-buffer "font-lock" nil t))
 105
 106 ;;; Custom
 107 (defgroup ges-post nil
 108   "Customisations for ges-post."
 109   :prefix "ges-post-"
 110   :group 'gnus-message)
 111
 112 (defcustom ges-post-use-mime nil
 113   "*When non-nil post as a MIME attachment."
 114   :group 'ges-post
 115   :type 'boolean)
 116
 117 (defcustom ges-post-gnus-plugged t
 118   "*When non-nil, start Gnus in \"plugged\" mode."
 119   :group 'ges-post
 120   :type 'boolean)
 121
 122 (defcustom ges-post-advertise t
 123   "*When non-nil advertise how the post was generated.
 124
 125 This inserts a line at the top of the article body advertising the
 126 fact that the post was generated with `ges-post'.  Simply set this to
 127 `nil' to turn this feature off."
 128   :type 'boolean
 129   :group 'ges-post)
 130
 131 (defcustom ges-post-use-followup-to-header t
 132   "*When non-nil, use a Followup-To header.
 133
 134 Sending followups to g.e.s if frowned upon.  That group is purely for
 135 sending source code.  For that reason it is recommended that this
 136 variable be left at its default value."
 137   :type 'boolean
 138   :group 'ges-post)
 139
 140 (defcustom ges-post-default-followup 'auto
 141   "What to set the Followup-To header to on posts to g.e.s.
 142
 143 Sending followups to g.e.s is frowned upon.  That group is purely for
 144 sending source code.  Use this variable to set an appropriate group
 145 for followups to your posts.
 146
 147 The default value auto causes ges-post to use one of the groups in
 148 `ges-post-possible-followup-groups'.  It uses the first one in that
 149 list that you are subscribed to.  If you are not subscribe d to any of
 150 those groups then a Followup-To header will not be set."
 151   :type '(choice
 152           (symbol :tag "Automatic" auto)
 153           (string :tag "gnu.emacs.help" :value "gnu.emacs.help")
 154           (string :tag "gnu.emacs.gnus" :value "gnu.emacs.gnus")
 155           (string :tag "comp.emacs.xemacs" :value "comp.emacs.xemacs")
 156           (string :tag "Followups to yourself" :value "poster")
 157           (string :tag "Stop it! You'll go blind." :value "gnu.emacs.sex")
 158           (string :tag "Other"))
 159   :group 'ges-post)
 160
 161 ;;;###autoload
 162 (defun ges-post-version (&optional arg)
 163   "Return the current version info for ges-post.
 164
 165 With optional argument ARG, insert version info at point in the current
 166 buffer."
 167   (interactive "P")
 168   (let (ver)
 169     (with-temp-buffer
 170       (erase-buffer)
 171       (insert-file (locate-library "ges-post.el"))
 172       (setq ver (lm-version)))
 173     (if (interactive-p)
 174         (if arg
 175             (insert (format "ges-post v%s" ver))
 176           (message "ges-post v%s" ver))
 177       ver)))
 178
 179 ;;;###autoload
 180 (defun ges-post-commentary ()
 181   "*Display the commentary section of ges-post.el."
 182   (interactive)
 183   (with-electric-help
 184    '(lambda ()
 185       (insert
 186        (with-temp-buffer
 187          (erase-buffer)
 188          (insert (lm-commentary (locate-library "ges-post.el")))
 189          (goto-char (point-min))
 190          (while (re-search-forward "^;+ ?" nil t)
 191            (replace-match "" nil nil))
 192          (buffer-string (current-buffer)))))
 193    "*ges-post Commentary*"))
 194
 195 ;;;###autoload
 196 (defun ges-post-copyright ()
 197   "*Display the copyright notice for ges-post."
 198   (interactive)
 199   (with-electric-help
 200    '(lambda ()
 201       (insert
 202        (with-temp-buffer
 203          (erase-buffer)
 204          (insert-file-contents (locate-library "ges-post.el"))
 205          (goto-char (point-min))
 206          (re-search-forward ";;; Commentary" nil t)
 207          (beginning-of-line)
 208          (narrow-to-region (point-min) (point))
 209          (while (re-search-backward "^;+ ?" nil t)
 210            (replace-match "" nil nil))
 211          (buffer-string (current-buffer)))))
 212    "*ges-post Copyright Notice*"))
 213
 214 (defconst ges-post-advertising-blurb
 215   (concat
 216    "(Automatically generated with ges-post.el, version "
 217    (ges-post-version)
 218    ")\n\n")
 219   "Blowing our own trumpet.")
 220
 221 (defconst ges-post-possible-followup-groups '("gnu.emacs.help"
 222                                               "gnu.emacs.gnus"
 223                                               "comp.emacs.xemacs")
 224   "List of groups that are possible candidates for Followup-To header.
 225
 226 As used in ges-post articles.")
 227
 228 (defun ges-post-compute-followup-header ()
 229   "Compute a value for the Followup-To header.
 230
 231 If `ges-post-default-followup' is non-nil, use that value.  Otherwise
 232 use the first group in `ges-post-possible-followup-groups' that you
 233 are subscribed to.
 234
 235 Returns either a name of a group as a string, or `nil'."
 236   (let* ((possibles ges-post-possible-followup-groups)
 237          (default ges-post-default-followup)
 238          (method (gnus-find-method-for-group "gnu.emacs.sources"))
 239          (known-groups (gnus-groups-from-server method))
 240          result done)
 241     (if (not (eq default 'auto))
 242         (progn
 243           (setq result default)
 244           (when (and (not (string= default "poster"))
 245                      (not (member default known-groups)))
 246             (unless (y-or-n-p (format "You are not subscribed to %s, use anyway? "
 247                                       default))
 248               (setq result nil)))
 249           result)
 250       (while (and possibles (not done))
 251         (when (member (car possibles) known-groups)
 252           (setq result (car possibles)
 253                 done t))
 254         (setq possibles (cdr possibles)))
 255       result)))
 256
 257 (defun ges-post-current-buffer ()
 258   "Prepare a posting of current buffer to gnu.emacs.sources.
 259 Point will be placed before first line so that you can add some
 260 comments."
 261   (interactive)
 262   (let* ((mybuf (current-buffer))
 263          (name (or (lm-get-package-name)
 264                    (read-string "Package name: ")))
 265          (summary (or (lm-summary)
 266                       (read-string "Short one-line description of package: ")))
 267          (version (or (lm-version)
 268                       (read-string "Package version: ")))
 269          (shortname (file-name-sans-extension name))
 270          (subject (concat shortname " " version " -- " summary)))
 271     ;; If Gnus isn't running, start it.
 272     (unless (gnus-alive-p)
 273       (if ges-post-gnus-plugged
 274           (gnus)
 275         (gnus-unplugged)))
 276     (gnus-group-post-news 1)
 277     (unless (message-field-value "Newsgroups")
 278       (message-goto-newsgroups)
 279       (insert "gnu.emacs.sources"))
 280     (message-goto-subject)
 281     (insert subject)
 282     (when (and (ges-post-compute-followup-header)
 283                (not (message-field-value "Followup-To"))
 284                ges-post-use-followup-to-header)
 285       (message-goto-followup-to)
 286       (insert (format "%s" (ges-post-compute-followup-header))))
 287     (message-goto-body)
 288     (if ges-post-use-mime
 289         (mml-insert-empty-tag 'part
 290                               'type "application/emacs-lisp"
 291                               'buffer (buffer-name mybuf)
 292                               'disposition "inline"
 293                               'description name)
 294       (insert-buffer mybuf))
 295     (when ges-post-advertise
 296       (message-goto-body)
 297       (insert ges-post-advertising-blurb))
 298     (when (featurep 'font-lock) (font-lock-fontify-buffer))
 299     (if (y-or-n-p "Do you wish to add/alter anything before sending? ")
 300         (message-goto-body)
 301       (message-send-and-exit))))
 302
 303 (defalias 'ges-post 'ges-post-current-buffer)
 304
 305 ;;;###autoload
 306 (defun ges-post-file (file)
 307   "Post an emacs lisp file to gnu.emacs.sources via Gnus."
 308   (interactive "fEmacs lisp file to post to g.e.s: ")
 309   (let ((buf (find-file-noselect file)))
 310     (set-buffer buf)
 311     (ges-post)
 312     (kill-buffer buf)))
 313
 314 (define-key emacs-lisp-mode-map "\M-\C-g" 'ges-post-current-buffer)
 315
 316 ;;;###autoload(add-hook 'emacs-lisp-mode-hook '(lambda () (require 'ges-post)))
 317
 318 (provide 'ges-post)
 319
 320 ;;; ges-post.el ends here
 321
 322 ;Local Variables:
 323 ;time-stamp-start: "Last-Modified:[     ]+\\\\?[\"<]+"
 324 ;time-stamp-end: "\\\\?[\">]"
 325 ;time-stamp-line-limit: 15
 326 ;time-stamp-format: "%4y-%02m-%02d %02H:%02M:%02S (%u)"
 327 ;End: