[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-sum.el

[Juanma Barranquero]

Index: emacs/lisp/gnus/gnus-sum.el
diff -c emacs/lisp/gnus/gnus-sum.el:1.37 emacs/lisp/gnus/gnus-sum.el:1.38
*** emacs/lisp/gnus/gnus-sum.el:1.37    Thu Jan 16 18:10:22 2003
--- emacs/lisp/gnus/gnus-sum.el Tue Feb  4 08:06:38 2003
***************
*** 1825,1831 ****
            gnus-article-commands-menu gnus-article-mode-map ""
            (cons "Commands" innards))
        ;; in Emacs, don't share menu.
!       (setq gnus-article-commands-menu 
              (copy-keymap gnus-summary-article-menu))
        (define-key gnus-article-mode-map [menu-bar commands]
          (cons "Commands" gnus-article-commands-menu))))
--- 1825,1831 ----
            gnus-article-commands-menu gnus-article-mode-map ""
            (cons "Commands" innards))
        ;; in Emacs, don't share menu.
!       (setq gnus-article-commands-menu
              (copy-keymap gnus-summary-article-menu))
        (define-key gnus-article-mode-map [menu-bar commands]
          (cons "Commands" gnus-article-commands-menu))))
***************
*** 3757,3764 ****
        threads
      (gnus-message 8 "Sorting threads...")
      (prog1
!       (gnus-sort-threads-1 
!        threads 
         (gnus-make-sort-function gnus-thread-sort-functions))
        (gnus-message 8 "Sorting threads...done"))))
  
--- 3757,3764 ----
        threads
      (gnus-message 8 "Sorting threads...")
      (prog1
!       (gnus-sort-threads-1
!        threads
         (gnus-make-sort-function gnus-thread-sort-functions))
        (gnus-message 8 "Sorting threads...done"))))
  
***************
*** 4196,4202 ****
                    gnus-list-identifiers
                  (mapconcat 'identity gnus-list-identifiers " *\\|"))))
      (dolist (header gnus-newsgroup-headers)
!       (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp 
                                  " *\\)\\)+\\(Re: +\\)?\\)")
                          (mail-header-subject header))
        (mail-header-set-subject
--- 4196,4202 ----
                    gnus-list-identifiers
                  (mapconcat 'identity gnus-list-identifiers " *\\|"))))
      (dolist (header gnus-newsgroup-headers)
!       (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
                                  " *\\)\\)+\\(Re: +\\)?\\)")
                          (mail-header-subject header))
        (mail-header-set-subject
***************
*** 4418,4424 ****
             (gnus-sorted-complement gnus-newsgroup-unreads articles)))
        (when gnus-alter-articles-to-read-function
        (setq gnus-newsgroup-unreads
!             (sort 
               (funcall gnus-alter-articles-to-read-function
                        gnus-newsgroup-name gnus-newsgroup-unreads)
               '<)))
--- 4418,4424 ----
             (gnus-sorted-complement gnus-newsgroup-unreads articles)))
        (when gnus-alter-articles-to-read-function
        (setq gnus-newsgroup-unreads
!             (sort
               (funcall gnus-alter-articles-to-read-function
                        gnus-newsgroup-name gnus-newsgroup-unreads)
               '<)))
***************
*** 4530,4536 ****
  
        (unless (memq (cdr type) uncompressed)
          (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
!        
        (when (gnus-check-backend-function
               'request-set-mark gnus-newsgroup-name)
          ;; propagate flags to server, with the following exceptions:
--- 4530,4536 ----
  
        (unless (memq (cdr type) uncompressed)
          (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
! 
        (when (gnus-check-backend-function
               'request-set-mark gnus-newsgroup-name)
          ;; propagate flags to server, with the following exceptions:
***************
*** 4549,4555 ****
                (push (list add 'add (list (cdr type))) delta-marks))
              (when del
                (push (list del 'del (list (cdr type))) delta-marks)))))
!         
        (when list
          (push (cons (cdr type) list) newmarked)))
  
--- 4549,4555 ----
                (push (list add 'add (list (cdr type))) delta-marks))
              (when del
                (push (list del 'del (list (cdr type))) delta-marks)))))
! 
        (when list
          (push (cons (cdr type) list) newmarked)))
  
***************
*** 4557,4563 ****
        (unless (gnus-check-group gnus-newsgroup-name)
          (error "Can't open server for %s" gnus-newsgroup-name))
        (gnus-request-set-mark gnus-newsgroup-name delta-marks))
!         
        ;; Enter these new marks into the info of the group.
        (if (nthcdr 3 info)
          (setcar (nthcdr 3 info) newmarked)
--- 4557,4563 ----
        (unless (gnus-check-group gnus-newsgroup-name)
          (error "Can't open server for %s" gnus-newsgroup-name))
        (gnus-request-set-mark gnus-newsgroup-name delta-marks))
! 
        ;; Enter these new marks into the info of the group.
        (if (nthcdr 3 info)
          (setcar (nthcdr 3 info) newmarked)
***************
*** 4589,4597 ****
        (let* ((mformat (symbol-value
                         (intern
                          (format "gnus-%s-mode-line-format-spec" where))))
!              (gnus-tmp-group-name (gnus-group-name-decode 
                                     gnus-newsgroup-name
!                                    (gnus-group-name-charset 
                                      nil
                                      gnus-newsgroup-name)))
               (gnus-tmp-article-number (or gnus-current-article 0))
--- 4589,4597 ----
        (let* ((mformat (symbol-value
                         (intern
                          (format "gnus-%s-mode-line-format-spec" where))))
!              (gnus-tmp-group-name (gnus-group-name-decode
                                     gnus-newsgroup-name
!                                    (gnus-group-name-charset
                                      nil
                                      gnus-newsgroup-name)))
               (gnus-tmp-article-number (or gnus-current-article 0))
***************
*** 6406,6422 ****
  (defun gnus-summary-limit-to-subject (subject &optional header not-matching)
    "Limit the summary buffer to articles that have subjects that match a 
regexp.
  If NOT-MATCHING, excluding articles that have subjects that match a regexp."
!   (interactive 
     (list (read-string (if current-prefix-arg
                          "Exclude subject (regexp): "
!                       "Limit to subject (regexp): ")) 
         nil current-prefix-arg))
    (unless header
      (setq header "subject"))
    (when (not (equal "" subject))
      (prog1
        (let ((articles (gnus-summary-find-matching
!                        (or header "subject") subject 'all nil nil 
                         not-matching)))
          (unless articles
            (error "Found no matches for \"%s\"" subject))
--- 6406,6422 ----
  (defun gnus-summary-limit-to-subject (subject &optional header not-matching)
    "Limit the summary buffer to articles that have subjects that match a 
regexp.
  If NOT-MATCHING, excluding articles that have subjects that match a regexp."
!   (interactive
     (list (read-string (if current-prefix-arg
                          "Exclude subject (regexp): "
!                       "Limit to subject (regexp): "))
         nil current-prefix-arg))
    (unless header
      (setq header "subject"))
    (when (not (equal "" subject))
      (prog1
        (let ((articles (gnus-summary-find-matching
!                        (or header "subject") subject 'all nil nil
                         not-matching)))
          (unless articles
            (error "Found no matches for \"%s\"" subject))
***************
*** 6426,6435 ****
  (defun gnus-summary-limit-to-author (from &optional not-matching)
    "Limit the summary buffer to articles that have authors that match a regexp.
  If NOT-MATCHING, excluding articles that have authors that match a regexp."
!   (interactive 
     (list (read-string (if current-prefix-arg
                          "Exclude author (regexp): "
!                       "Limit to author (regexp): ")) 
         current-prefix-arg))
    (gnus-summary-limit-to-subject from "from" not-matching))
  
--- 6426,6435 ----
  (defun gnus-summary-limit-to-author (from &optional not-matching)
    "Limit the summary buffer to articles that have authors that match a regexp.
  If NOT-MATCHING, excluding articles that have authors that match a regexp."
!   (interactive
     (list (read-string (if current-prefix-arg
                          "Exclude author (regexp): "
!                       "Limit to author (regexp): "))
         current-prefix-arg))
    (gnus-summary-limit-to-subject from "from" not-matching))
  
***************
*** 6487,6500 ****
            nil
            t))))
       (list header
!          (read-string (format "%s header %s (regexp): " 
                                (if current-prefix-arg "Exclude" "Limit to")
                                header))
           current-prefix-arg)))
    (when (not (equal "" regexp))
      (prog1
        (let ((articles (gnus-summary-find-matching
!                        (cons 'extra header) regexp 'all nil nil 
                         not-matching)))
          (unless articles
            (error "Found no matches for \"%s\"" regexp))
--- 6487,6500 ----
            nil
            t))))
       (list header
!          (read-string (format "%s header %s (regexp): "
                                (if current-prefix-arg "Exclude" "Limit to")
                                header))
           current-prefix-arg)))
    (when (not (equal "" regexp))
      (prog1
        (let ((articles (gnus-summary-find-matching
!                        (cons 'extra header) regexp 'all nil nil
                         not-matching)))
          (unless articles
            (error "Found no matches for \"%s\"" regexp))
***************
*** 7053,7060 ****
        ;; the parent article.
        (when (setq to-address (or (message-fetch-field "reply-to")
                                   (message-fetch-field "from")))
!         (setq params (append 
!                       (list (cons 'to-address 
                                    (funcall gnus-decode-encoded-word-function
                                             to-address))))))
        (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
--- 7053,7060 ----
        ;; the parent article.
        (when (setq to-address (or (message-fetch-field "reply-to")
                                   (message-fetch-field "from")))
!         (setq params (append
!                       (list (cons 'to-address
                                    (funcall gnus-decode-encoded-word-function
                                             to-address))))))
        (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
***************
*** 7248,7254 ****
  BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
  If UNREAD is non-nil, only unread articles will
  be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
! in the comparisons. If NOT-MATCHING, return a list of all articles that 
  not match REGEXP on HEADER."
    (let ((case-fold-search (not not-case-fold))
        articles d func)
--- 7248,7254 ----
  BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
  If UNREAD is non-nil, only unread articles will
  be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
! in the comparisons. If NOT-MATCHING, return a list of all articles that
  not match REGEXP on HEADER."
    (let ((case-fold-search (not not-case-fold))
        articles d func)
***************
*** 7271,7277 ****
                     (gnus-data-unread-p d)) ; Or just unreads.
                 (vectorp (gnus-data-header d)) ; It's not a pseudo.
                 (if not-matching
!                    (not (string-match 
                           regexp
                           (funcall func (gnus-data-header d))))
                   (string-match regexp
--- 7271,7277 ----
                     (gnus-data-unread-p d)) ; Or just unreads.
                 (vectorp (gnus-data-header d)) ; It's not a pseudo.
                 (if not-matching
!                    (not (string-match
                           regexp
                           (funcall func (gnus-data-header d))))
                   (string-match regexp
***************
*** 7936,7948 ****
    "Edit the current article.
  This will have permanent effect only in mail groups.
  If ARG is nil, edit the decoded articles.
! If ARG is 1, edit the raw articles. 
  If ARG is 2, edit the raw articles even in read-only groups.
  Otherwise, allow editing of articles even in read-only
  groups."
    (interactive "P")
    (let (force raw)
!     (cond 
       ((null arg))
       ((eq arg 1) (setq raw t))
       ((eq arg 2) (setq raw t
--- 7936,7948 ----
    "Edit the current article.
  This will have permanent effect only in mail groups.
  If ARG is nil, edit the decoded articles.
! If ARG is 1, edit the raw articles.
  If ARG is 2, edit the raw articles even in read-only groups.
  Otherwise, allow editing of articles even in read-only
  groups."
    (interactive "P")
    (let (force raw)
!     (cond
       ((null arg))
       ((eq arg 1) (setq raw t))
       ((eq arg 2) (setq raw t
***************
*** 7965,7972 ****
        (if (equal gnus-newsgroup-name "nndraft:drafts")
            (setq raw t))
        (gnus-article-edit-article
!        (if raw 'ignore 
!          #'(lambda () 
               (let ((mbl mml-buffer-list))
                 (setq mml-buffer-list nil)
                 (mime-to-mml)
--- 7965,7972 ----
        (if (equal gnus-newsgroup-name "nndraft:drafts")
            (setq raw t))
        (gnus-article-edit-article
!        (if raw 'ignore
!          #'(lambda ()
               (let ((mbl mml-buffer-list))
                 (setq mml-buffer-list nil)
                 (mime-to-mml)
***************
*** 7977,7993 ****
                 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
         `(lambda (no-highlight)
            (let ((mail-parse-charset ',gnus-newsgroup-charset)
!                 (mail-parse-ignored-charsets 
                   ',gnus-newsgroup-ignored-charsets))
!             ,(if (not raw) '(progn 
                                (mml-to-mime)
                                (mml-destroy-buffers)
!                               (remove-hook 'kill-buffer-hook 
                                             'mml-destroy-buffers t)
                                (kill-local-variable 'mml-buffer-list)))
              (gnus-summary-edit-article-done
               ,(or (mail-header-references gnus-current-headers) "")
!              ,(gnus-group-read-only-p) 
               ,gnus-summary-buffer no-highlight))))))))
  
  (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
--- 7977,7993 ----
                 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
         `(lambda (no-highlight)
            (let ((mail-parse-charset ',gnus-newsgroup-charset)
!                 (mail-parse-ignored-charsets
                   ',gnus-newsgroup-ignored-charsets))
!             ,(if (not raw) '(progn
                                (mml-to-mime)
                                (mml-destroy-buffers)
!                               (remove-hook 'kill-buffer-hook
                                             'mml-destroy-buffers t)
                                (kill-local-variable 'mml-buffer-list)))
              (gnus-summary-edit-article-done
               ,(or (mail-header-references gnus-current-headers) "")
!              ,(gnus-group-read-only-p)
               ,gnus-summary-buffer no-highlight))))))))
  
  (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
***************
*** 9349,9360 ****
    "Save parts matching TYPE to DIR.
  If REVERSE, save parts that do not match TYPE."
    (interactive
!    (list (read-string "Save parts of type: " 
                      (or (car gnus-summary-save-parts-type-history)
                          gnus-summary-save-parts-default-mime)
                      'gnus-summary-save-parts-type-history)
         (setq gnus-summary-save-parts-last-directory
!              (read-file-name "Save to directory: " 
                               gnus-summary-save-parts-last-directory
                               nil t))
         current-prefix-arg))
--- 9349,9360 ----
    "Save parts matching TYPE to DIR.
  If REVERSE, save parts that do not match TYPE."
    (interactive
!    (list (read-string "Save parts of type: "
                      (or (car gnus-summary-save-parts-type-history)
                          gnus-summary-save-parts-default-mime)
                      'gnus-summary-save-parts-type-history)
         (setq gnus-summary-save-parts-last-directory
!              (read-file-name "Save to directory: "
                               gnus-summary-save-parts-last-directory
                               nil t))
         current-prefix-arg))
***************
*** 9697,9703 ****
              `(progn
                 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
                 (gnus-info-set-read ',info ',(gnus-info-read info))
!                (gnus-get-unread-articles-in-group ',info 
                                                    (gnus-active ,group))
                 (gnus-group-update-group ,group t)
                 ,setmarkundo))))
--- 9697,9703 ----
              `(progn
                 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
                 (gnus-info-set-read ',info ',(gnus-info-read info))
!                (gnus-get-unread-articles-in-group ',info
                                                    (gnus-active ,group))
                 (gnus-group-update-group ,group t)
                 ,setmarkundo))))
***************
*** 9848,9854 ****
                   mark (car lway) lway name)))
        (setq func (eval func))
        (define-key map (nth 4 lway) func)))))
!       
  (defun gnus-summary-make-marking-command-1 (mark way lway name)
    `(defun ,(intern
            (format "gnus-summary-put-mark-as-%s%s"
--- 9848,9854 ----
                   mark (car lway) lway name)))
        (setq func (eval func))
        (define-key map (nth 4 lway) func)))))
! 
  (defun gnus-summary-make-marking-command-1 (mark way lway name)
    `(defun ,(intern
            (format "gnus-summary-put-mark-as-%s%s"
***************
*** 9865,9871 ****
         name (cadr lway))
       (interactive "p")
       (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
!     
  (defun gnus-summary-generic-mark (n mark move unread)
    "Mark N articles with MARK."
    (unless (eq major-mode 'gnus-summary-mode)
--- 9865,9871 ----
         name (cadr lway))
       (interactive "p")
       (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
! 
  (defun gnus-summary-generic-mark (n mark move unread)
    "Mark N articles with MARK."
    (unless (eq major-mode 'gnus-summary-mode)