/[emacs]/emacs/lisp/gnus/gnus-sum.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-sum.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37 by zsh, Thu Jan 16 23:10:22 2003 UTC revision 1.38 by lektu, Tue Feb 4 13:06:38 2003 UTC
# Line 1825  increase the score of each group you rea Line 1825  increase the score of each group you rea
1825              gnus-article-commands-menu gnus-article-mode-map ""              gnus-article-commands-menu gnus-article-mode-map ""
1826              (cons "Commands" innards))              (cons "Commands" innards))
1827          ;; in Emacs, don't share menu.          ;; in Emacs, don't share menu.
1828          (setq gnus-article-commands-menu          (setq gnus-article-commands-menu
1829                (copy-keymap gnus-summary-article-menu))                (copy-keymap gnus-summary-article-menu))
1830          (define-key gnus-article-mode-map [menu-bar commands]          (define-key gnus-article-mode-map [menu-bar commands]
1831            (cons "Commands" gnus-article-commands-menu))))            (cons "Commands" gnus-article-commands-menu))))
# Line 3757  If LINE, insert the rebuilt thread start Line 3757  If LINE, insert the rebuilt thread start
3757        threads        threads
3758      (gnus-message 8 "Sorting threads...")      (gnus-message 8 "Sorting threads...")
3759      (prog1      (prog1
3760          (gnus-sort-threads-1          (gnus-sort-threads-1
3761           threads           threads
3762           (gnus-make-sort-function gnus-thread-sort-functions))           (gnus-make-sort-function gnus-thread-sort-functions))
3763        (gnus-message 8 "Sorting threads...done"))))        (gnus-message 8 "Sorting threads...done"))))
3764    
# Line 4196  or a straight list of headers." Line 4196  or a straight list of headers."
4196                      gnus-list-identifiers                      gnus-list-identifiers
4197                    (mapconcat 'identity gnus-list-identifiers " *\\|"))))                    (mapconcat 'identity gnus-list-identifiers " *\\|"))))
4198      (dolist (header gnus-newsgroup-headers)      (dolist (header gnus-newsgroup-headers)
4199        (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp        (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
4200                                    " *\\)\\)+\\(Re: +\\)?\\)")                                    " *\\)\\)+\\(Re: +\\)?\\)")
4201                            (mail-header-subject header))                            (mail-header-subject header))
4202          (mail-header-set-subject          (mail-header-set-subject
# Line 4418  If SELECT-ARTICLES, only select those ar Line 4418  If SELECT-ARTICLES, only select those ar
4418               (gnus-sorted-complement gnus-newsgroup-unreads articles)))               (gnus-sorted-complement gnus-newsgroup-unreads articles)))
4419        (when gnus-alter-articles-to-read-function        (when gnus-alter-articles-to-read-function
4420          (setq gnus-newsgroup-unreads          (setq gnus-newsgroup-unreads
4421                (sort                (sort
4422                 (funcall gnus-alter-articles-to-read-function                 (funcall gnus-alter-articles-to-read-function
4423                          gnus-newsgroup-name gnus-newsgroup-unreads)                          gnus-newsgroup-name gnus-newsgroup-unreads)
4424                 '<)))                 '<)))
# Line 4530  If SELECT-ARTICLES, only select those ar Line 4530  If SELECT-ARTICLES, only select those ar
4530    
4531          (unless (memq (cdr type) uncompressed)          (unless (memq (cdr type) uncompressed)
4532            (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))            (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
4533          
4534          (when (gnus-check-backend-function          (when (gnus-check-backend-function
4535                 'request-set-mark gnus-newsgroup-name)                 'request-set-mark gnus-newsgroup-name)
4536            ;; propagate flags to server, with the following exceptions:            ;; propagate flags to server, with the following exceptions:
# Line 4549  If SELECT-ARTICLES, only select those ar Line 4549  If SELECT-ARTICLES, only select those ar
4549                  (push (list add 'add (list (cdr type))) delta-marks))                  (push (list add 'add (list (cdr type))) delta-marks))
4550                (when del                (when del
4551                  (push (list del 'del (list (cdr type))) delta-marks)))))                  (push (list del 'del (list (cdr type))) delta-marks)))))
4552              
4553          (when list          (when list
4554            (push (cons (cdr type) list) newmarked)))            (push (cons (cdr type) list) newmarked)))
4555    
# Line 4557  If SELECT-ARTICLES, only select those ar Line 4557  If SELECT-ARTICLES, only select those ar
4557          (unless (gnus-check-group gnus-newsgroup-name)          (unless (gnus-check-group gnus-newsgroup-name)
4558            (error "Can't open server for %s" gnus-newsgroup-name))            (error "Can't open server for %s" gnus-newsgroup-name))
4559          (gnus-request-set-mark gnus-newsgroup-name delta-marks))          (gnus-request-set-mark gnus-newsgroup-name delta-marks))
4560              
4561        ;; Enter these new marks into the info of the group.        ;; Enter these new marks into the info of the group.
4562        (if (nthcdr 3 info)        (if (nthcdr 3 info)
4563            (setcar (nthcdr 3 info) newmarked)            (setcar (nthcdr 3 info) newmarked)
# Line 4589  If WHERE is `summary', the summary mode Line 4589  If WHERE is `summary', the summary mode
4589          (let* ((mformat (symbol-value          (let* ((mformat (symbol-value
4590                           (intern                           (intern
4591                            (format "gnus-%s-mode-line-format-spec" where))))                            (format "gnus-%s-mode-line-format-spec" where))))
4592                 (gnus-tmp-group-name (gnus-group-name-decode                 (gnus-tmp-group-name (gnus-group-name-decode
4593                                       gnus-newsgroup-name                                       gnus-newsgroup-name
4594                                       (gnus-group-name-charset                                       (gnus-group-name-charset
4595                                        nil                                        nil
4596                                        gnus-newsgroup-name)))                                        gnus-newsgroup-name)))
4597                 (gnus-tmp-article-number (or gnus-current-article 0))                 (gnus-tmp-article-number (or gnus-current-article 0))
# Line 6406  If given a prefix, remove all limits." Line 6406  If given a prefix, remove all limits."
6406  (defun gnus-summary-limit-to-subject (subject &optional header not-matching)  (defun gnus-summary-limit-to-subject (subject &optional header not-matching)
6407    "Limit the summary buffer to articles that have subjects that match a regexp.    "Limit the summary buffer to articles that have subjects that match a regexp.
6408  If NOT-MATCHING, excluding articles that have subjects that match a regexp."  If NOT-MATCHING, excluding articles that have subjects that match a regexp."
6409    (interactive    (interactive
6410     (list (read-string (if current-prefix-arg     (list (read-string (if current-prefix-arg
6411                            "Exclude subject (regexp): "                            "Exclude subject (regexp): "
6412                          "Limit to subject (regexp): "))                          "Limit to subject (regexp): "))
6413           nil current-prefix-arg))           nil current-prefix-arg))
6414    (unless header    (unless header
6415      (setq header "subject"))      (setq header "subject"))
6416    (when (not (equal "" subject))    (when (not (equal "" subject))
6417      (prog1      (prog1
6418          (let ((articles (gnus-summary-find-matching          (let ((articles (gnus-summary-find-matching
6419                           (or header "subject") subject 'all nil nil                           (or header "subject") subject 'all nil nil
6420                           not-matching)))                           not-matching)))
6421            (unless articles            (unless articles
6422              (error "Found no matches for \"%s\"" subject))              (error "Found no matches for \"%s\"" subject))
# Line 6426  If NOT-MATCHING, excluding articles that Line 6426  If NOT-MATCHING, excluding articles that
6426  (defun gnus-summary-limit-to-author (from &optional not-matching)  (defun gnus-summary-limit-to-author (from &optional not-matching)
6427    "Limit the summary buffer to articles that have authors that match a regexp.    "Limit the summary buffer to articles that have authors that match a regexp.
6428  If NOT-MATCHING, excluding articles that have authors that match a regexp."  If NOT-MATCHING, excluding articles that have authors that match a regexp."
6429    (interactive    (interactive
6430     (list (read-string (if current-prefix-arg     (list (read-string (if current-prefix-arg
6431                            "Exclude author (regexp): "                            "Exclude author (regexp): "
6432                          "Limit to author (regexp): "))                          "Limit to author (regexp): "))
6433           current-prefix-arg))           current-prefix-arg))
6434    (gnus-summary-limit-to-subject from "from" not-matching))    (gnus-summary-limit-to-subject from "from" not-matching))
6435    
# Line 6487  articles that are younger than AGE days. Line 6487  articles that are younger than AGE days.
6487              nil              nil
6488              t))))              t))))
6489       (list header       (list header
6490             (read-string (format "%s header %s (regexp): "             (read-string (format "%s header %s (regexp): "
6491                                  (if current-prefix-arg "Exclude" "Limit to")                                  (if current-prefix-arg "Exclude" "Limit to")
6492                                  header))                                  header))
6493             current-prefix-arg)))             current-prefix-arg)))
6494    (when (not (equal "" regexp))    (when (not (equal "" regexp))
6495      (prog1      (prog1
6496          (let ((articles (gnus-summary-find-matching          (let ((articles (gnus-summary-find-matching
6497                           (cons 'extra header) regexp 'all nil nil                           (cons 'extra header) regexp 'all nil nil
6498                           not-matching)))                           not-matching)))
6499            (unless articles            (unless articles
6500              (error "Found no matches for \"%s\"" regexp))              (error "Found no matches for \"%s\"" regexp))
# Line 7053  to guess what the document format is." Line 7053  to guess what the document format is."
7053          ;; the parent article.          ;; the parent article.
7054          (when (setq to-address (or (message-fetch-field "reply-to")          (when (setq to-address (or (message-fetch-field "reply-to")
7055                                     (message-fetch-field "from")))                                     (message-fetch-field "from")))
7056            (setq params (append            (setq params (append
7057                          (list (cons 'to-address                          (list (cons 'to-address
7058                                      (funcall gnus-decode-encoded-word-function                                      (funcall gnus-decode-encoded-word-function
7059                                               to-address))))))                                               to-address))))))
7060          (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))          (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
# Line 7248  The search stars on the current article Line 7248  The search stars on the current article
7248  BACKWARD is non-nil.  If BACKWARD is `all', do all articles.  BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
7249  If UNREAD is non-nil, only unread articles will  If UNREAD is non-nil, only unread articles will
7250  be taken into consideration.  If NOT-CASE-FOLD, case won't be folded  be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
7251  in the comparisons. If NOT-MATCHING, return a list of all articles that  in the comparisons. If NOT-MATCHING, return a list of all articles that
7252  not match REGEXP on HEADER."  not match REGEXP on HEADER."
7253    (let ((case-fold-search (not not-case-fold))    (let ((case-fold-search (not not-case-fold))
7254          articles d func)          articles d func)
# Line 7271  not match REGEXP on HEADER." Line 7271  not match REGEXP on HEADER."
7271                       (gnus-data-unread-p d)) ; Or just unreads.                       (gnus-data-unread-p d)) ; Or just unreads.
7272                   (vectorp (gnus-data-header d)) ; It's not a pseudo.                   (vectorp (gnus-data-header d)) ; It's not a pseudo.
7273                   (if not-matching                   (if not-matching
7274                       (not (string-match                       (not (string-match
7275                             regexp                             regexp
7276                             (funcall func (gnus-data-header d))))                             (funcall func (gnus-data-header d))))
7277                     (string-match regexp                     (string-match regexp
# Line 7936  delete these instead." Line 7936  delete these instead."
7936    "Edit the current article.    "Edit the current article.
7937  This will have permanent effect only in mail groups.  This will have permanent effect only in mail groups.
7938  If ARG is nil, edit the decoded articles.  If ARG is nil, edit the decoded articles.
7939  If ARG is 1, edit the raw articles.  If ARG is 1, edit the raw articles.
7940  If ARG is 2, edit the raw articles even in read-only groups.  If ARG is 2, edit the raw articles even in read-only groups.
7941  Otherwise, allow editing of articles even in read-only  Otherwise, allow editing of articles even in read-only
7942  groups."  groups."
7943    (interactive "P")    (interactive "P")
7944    (let (force raw)    (let (force raw)
7945      (cond      (cond
7946       ((null arg))       ((null arg))
7947       ((eq arg 1) (setq raw t))       ((eq arg 1) (setq raw t))
7948       ((eq arg 2) (setq raw t       ((eq arg 2) (setq raw t
# Line 7965  groups." Line 7965  groups."
7965          (if (equal gnus-newsgroup-name "nndraft:drafts")          (if (equal gnus-newsgroup-name "nndraft:drafts")
7966              (setq raw t))              (setq raw t))
7967          (gnus-article-edit-article          (gnus-article-edit-article
7968           (if raw 'ignore           (if raw 'ignore
7969             #'(lambda ()             #'(lambda ()
7970                 (let ((mbl mml-buffer-list))                 (let ((mbl mml-buffer-list))
7971                   (setq mml-buffer-list nil)                   (setq mml-buffer-list nil)
7972                   (mime-to-mml)                   (mime-to-mml)
# Line 7977  groups." Line 7977  groups."
7977                   (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))                   (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
7978           `(lambda (no-highlight)           `(lambda (no-highlight)
7979              (let ((mail-parse-charset ',gnus-newsgroup-charset)              (let ((mail-parse-charset ',gnus-newsgroup-charset)
7980                    (mail-parse-ignored-charsets                    (mail-parse-ignored-charsets
7981                     ',gnus-newsgroup-ignored-charsets))                     ',gnus-newsgroup-ignored-charsets))
7982                ,(if (not raw) '(progn                ,(if (not raw) '(progn
7983                                  (mml-to-mime)                                  (mml-to-mime)
7984                                  (mml-destroy-buffers)                                  (mml-destroy-buffers)
7985                                  (remove-hook 'kill-buffer-hook                                  (remove-hook 'kill-buffer-hook
7986                                               'mml-destroy-buffers t)                                               'mml-destroy-buffers t)
7987                                  (kill-local-variable 'mml-buffer-list)))                                  (kill-local-variable 'mml-buffer-list)))
7988                (gnus-summary-edit-article-done                (gnus-summary-edit-article-done
7989                 ,(or (mail-header-references gnus-current-headers) "")                 ,(or (mail-header-references gnus-current-headers) "")
7990                 ,(gnus-group-read-only-p)                 ,(gnus-group-read-only-p)
7991                 ,gnus-summary-buffer no-highlight))))))))                 ,gnus-summary-buffer no-highlight))))))))
7992    
7993  (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)  (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
# Line 9349  save those articles instead." Line 9349  save those articles instead."
9349    "Save parts matching TYPE to DIR.    "Save parts matching TYPE to DIR.
9350  If REVERSE, save parts that do not match TYPE."  If REVERSE, save parts that do not match TYPE."
9351    (interactive    (interactive
9352     (list (read-string "Save parts of type: "     (list (read-string "Save parts of type: "
9353                        (or (car gnus-summary-save-parts-type-history)                        (or (car gnus-summary-save-parts-type-history)
9354                            gnus-summary-save-parts-default-mime)                            gnus-summary-save-parts-default-mime)
9355                        'gnus-summary-save-parts-type-history)                        'gnus-summary-save-parts-type-history)
9356           (setq gnus-summary-save-parts-last-directory           (setq gnus-summary-save-parts-last-directory
9357                 (read-file-name "Save to directory: "                 (read-file-name "Save to directory: "
9358                                 gnus-summary-save-parts-last-directory                                 gnus-summary-save-parts-last-directory
9359                                 nil t))                                 nil t))
9360           current-prefix-arg))           current-prefix-arg))
# Line 9697  If REVERSE, save parts that do not match Line 9697  If REVERSE, save parts that do not match
9697                `(progn                `(progn
9698                   (gnus-info-set-marks ',info ',(gnus-info-marks info) t)                   (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
9699                   (gnus-info-set-read ',info ',(gnus-info-read info))                   (gnus-info-set-read ',info ',(gnus-info-read info))
9700                   (gnus-get-unread-articles-in-group ',info                   (gnus-get-unread-articles-in-group ',info
9701                                                      (gnus-active ,group))                                                      (gnus-active ,group))
9702                   (gnus-group-update-group ,group t)                   (gnus-group-update-group ,group t)
9703                   ,setmarkundo))))                   ,setmarkundo))))
# Line 9848  treated as multipart/mixed." Line 9848  treated as multipart/mixed."
9848                     mark (car lway) lway name)))                     mark (car lway) lway name)))
9849          (setq func (eval func))          (setq func (eval func))
9850          (define-key map (nth 4 lway) func)))))          (define-key map (nth 4 lway) func)))))
9851          
9852  (defun gnus-summary-make-marking-command-1 (mark way lway name)  (defun gnus-summary-make-marking-command-1 (mark way lway name)
9853    `(defun ,(intern    `(defun ,(intern
9854              (format "gnus-summary-put-mark-as-%s%s"              (format "gnus-summary-put-mark-as-%s%s"
# Line 9865  returned." Line 9865  returned."
9865         name (cadr lway))         name (cadr lway))
9866       (interactive "p")       (interactive "p")
9867       (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))       (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
9868        
9869  (defun gnus-summary-generic-mark (n mark move unread)  (defun gnus-summary-generic-mark (n mark move unread)
9870    "Mark N articles with MARK."    "Mark N articles with MARK."
9871    (unless (eq major-mode 'gnus-summary-mode)    (unless (eq major-mode 'gnus-summary-mode)

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26