[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-ml.el [emacs-unicode-2]

[Miles Bader]

Index: emacs/lisp/gnus/gnus-ml.el
diff -c emacs/lisp/gnus/gnus-ml.el:1.4.6.1 emacs/lisp/gnus/gnus-ml.el:1.4.6.2
*** emacs/lisp/gnus/gnus-ml.el:1.4.6.1  Fri Mar 12 00:02:57 2004
--- emacs/lisp/gnus/gnus-ml.el  Thu Sep  9 09:36:25 2004
***************
*** 1,6 ****
! ;;; gnus-ml.el --- mailing list minor mode for Gnus
  
! ;; Copyright (C) 2000 Free Software Foundation, Inc.
  
  ;; Author: Julien Gilles  <address@hidden>
  ;; Keywords: news
--- 1,6 ----
! ;;; gnus-ml.el --- Mailing list minor mode for Gnus
  
! ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
  
  ;; Author: Julien Gilles  <address@hidden>
  ;; Keywords: news
***************
*** 26,35 ****
  
  ;; implement (small subset of) RFC 2369
  
- ;;; Usage:
- 
- ;; (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode)
- 
  ;;; Code:
  
  (require 'gnus)
--- 26,31 ----
***************
*** 49,60 ****
    (setq gnus-mailing-list-mode-map (make-sparse-keymap))
  
    (gnus-define-keys gnus-mailing-list-mode-map
!     "\C-nh" gnus-mailing-list-help
!     "\C-ns" gnus-mailing-list-subscribe
!     "\C-nu" gnus-mailing-list-unsubscribe
!     "\C-np" gnus-mailing-list-post
!     "\C-no" gnus-mailing-list-owner
!     "\C-na" gnus-mailing-list-archive
      ))
  
  (defun gnus-mailing-list-make-menu-bar ()
--- 45,56 ----
    (setq gnus-mailing-list-mode-map (make-sparse-keymap))
  
    (gnus-define-keys gnus-mailing-list-mode-map
!     "\C-c\C-nh" gnus-mailing-list-help
!     "\C-c\C-ns" gnus-mailing-list-subscribe
!     "\C-c\C-nu" gnus-mailing-list-unsubscribe
!     "\C-c\C-np" gnus-mailing-list-post
!     "\C-c\C-no" gnus-mailing-list-owner
!     "\C-c\C-na" gnus-mailing-list-archive
      ))
  
  (defun gnus-mailing-list-make-menu-bar ()
***************
*** 71,80 ****
  
  ;;;###autoload
  (defun turn-on-gnus-mailing-list-mode ()
!   (when (gnus-group-get-parameter gnus-newsgroup-name 'to-list)
      (gnus-mailing-list-mode 1)))
  
  ;;;###autoload
  (defun gnus-mailing-list-mode (&optional arg)
    "Minor mode for providing mailing-list commands.
  
--- 67,95 ----
  
  ;;;###autoload
  (defun turn-on-gnus-mailing-list-mode ()
!   (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list)
      (gnus-mailing-list-mode 1)))
  
  ;;;###autoload
+ (defun gnus-mailing-list-insinuate (&optional force)
+   "Setup group parameters from List-Post header.
+ If FORCE is non-nil, replace the old ones."
+   (interactive "P")
+   (let ((list-post
+        (with-current-buffer gnus-original-article-buffer
+          (gnus-fetch-field "list-post"))))
+     (if list-post
+       (if (and (not force)
+                (gnus-group-get-parameter gnus-newsgroup-name 'to-list))
+           (gnus-message 1 "to-list is non-nil.")
+         (if (string-match "<mailto:\\([^>]*\\)>" list-post)
+             (setq list-post (match-string 1 list-post)))
+         (gnus-group-add-parameter gnus-newsgroup-name
+                                   (cons 'to-list list-post))
+         (gnus-mailing-list-mode 1))
+       (gnus-message 1 "no list-post in this message."))))
+ 
+ ;;;###autoload
  (defun gnus-mailing-list-mode (&optional arg)
    "Minor mode for providing mailing-list commands.
  
***************
*** 140,150 ****
  (defun gnus-mailing-list-archive ()
    "Browse archive"
    (interactive)
    (let ((list-archive
         (with-current-buffer gnus-original-article-buffer
           (gnus-fetch-field "list-archive"))))
!     (cond (list-archive (gnus-mailing-list-message list-archive))
!         (t (gnus-message 1 "no list-owner in this group")))))
  
  ;;; Utility functions
  
--- 155,169 ----
  (defun gnus-mailing-list-archive ()
    "Browse archive"
    (interactive)
+   (require 'browse-url)
    (let ((list-archive
         (with-current-buffer gnus-original-article-buffer
           (gnus-fetch-field "list-archive"))))
!     (cond (list-archive
!          (if (string-match "<\\(http:[^>]*\\)>" list-archive)
!              (browse-url (match-string 1 list-archive))
!            (browse-url list-archive)))
!         (t (gnus-message 1 "no list-archive in this group")))))
  
  ;;; Utility functions
  
***************
*** 158,164 ****
      (cond
       ((string-match "<mailto:\\([^>]*\\)>" address)
        (let ((args (match-string 1 address)))
!       (cond                                   ; with param
         ((string-match "\\(.*\\)\\?\\(.*\\)" args)
          (setq mailto (match-string 1 args))
          (let ((param (match-string 2 args)))
--- 177,183 ----
      (cond
       ((string-match "<mailto:\\([^>]*\\)>" address)
        (let ((args (match-string 1 address)))
!       (cond                           ; with param
         ((string-match "\\(.*\\)\\?\\(.*\\)" args)
          (setq mailto (match-string 1 args))
          (let ((param (match-string 2 args)))
***************
*** 169,175 ****
            (if (string-match "to=\\([^&]*\\)" param)
                (push (match-string 1 param) to))
            ))
!        (t (setq mailto args)))))                      ; without param
  
       ; other case <http://... to be done.
       (t nil))
--- 188,194 ----
            (if (string-match "to=\\([^&]*\\)" param)
                (push (match-string 1 param) to))
            ))
!        (t (setq mailto args)))))      ; without param
  
       ; other case <http://... to be done.
       (t nil))