Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-uu.el @ 167:85ec50267440 r20-3b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents fe104dbd9147
children 8eaf7971accc
comparison
equal deleted inserted replaced
166:7a77eb660975 167:85ec50267440
1775 (defcustom gnus-uu-post-threaded nil 1775 (defcustom gnus-uu-post-threaded nil
1776 "Non-nil means that gnus-uu will post the encoded file in a thread. 1776 "Non-nil means that gnus-uu will post the encoded file in a thread.
1777 This may not be smart, as no other decoder I have seen are able to 1777 This may not be smart, as no other decoder I have seen are able to
1778 follow threads when collecting uuencoded articles. (Well, I have seen 1778 follow threads when collecting uuencoded articles. (Well, I have seen
1779 one package that does that - gnus-uu, but somehow, I don't think that 1779 one package that does that - gnus-uu, but somehow, I don't think that
1780 counts...) Default is nil." 1780 counts...) The default is nil."
1781 :group 'gnus-extract-post 1781 :group 'gnus-extract-post
1782 :type 'boolean) 1782 :type 'boolean)
1783 1783
1784 (defcustom gnus-uu-post-separate-description t 1784 (defcustom gnus-uu-post-separate-description t
1785 "Non-nil means that the description will be posted in a separate article. 1785 "Non-nil means that the description will be posted in a separate article.
1874 1874
1875 (if gnus-uu-post-inserted-file-name 1875 (if gnus-uu-post-inserted-file-name
1876 (setq file-name gnus-uu-post-inserted-file-name) 1876 (setq file-name gnus-uu-post-inserted-file-name)
1877 (setq file-name (gnus-uu-post-insert-binary))) 1877 (setq file-name (gnus-uu-post-insert-binary)))
1878 1878
1879 (if gnus-uu-post-threaded 1879 (gnus-uu-post-encoded file-name gnus-uu-post-threaded))
1880 (let ((message-required-news-headers
1881 (if (memq 'Message-ID message-required-news-headers)
1882 message-required-news-headers
1883 (cons 'Message-ID message-required-news-headers)))
1884 gnus-inews-article-hook)
1885
1886 (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
1887 gnus-inews-article-hook
1888 (list gnus-inews-article-hook)))
1889 (push
1890 '(lambda ()
1891 (save-excursion
1892 (goto-char (point-min))
1893 (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
1894 (setq gnus-uu-post-message-id
1895 (buffer-substring
1896 (match-beginning 1) (match-end 1)))
1897 (setq gnus-uu-post-message-id nil))))
1898 gnus-inews-article-hook)
1899 (gnus-uu-post-encoded file-name t))
1900 (gnus-uu-post-encoded file-name nil)))
1901 (setq gnus-uu-post-inserted-file-name nil) 1880 (setq gnus-uu-post-inserted-file-name nil)
1902 (when gnus-uu-winconf-post-news 1881 (when gnus-uu-winconf-post-news
1903 (set-window-configuration gnus-uu-winconf-post-news))) 1882 (set-window-configuration gnus-uu-winconf-post-news)))
1904 1883
1905 ;; Asks for a file to encode, encodes it and inserts the result in 1884 ;; Asks for a file to encode, encodes it and inserts the result in
1962 (erase-buffer) 1941 (erase-buffer)
1963 (insert-buffer-substring post-buf beg-binary end-binary) 1942 (insert-buffer-substring post-buf beg-binary end-binary)
1964 (goto-char (point-min)) 1943 (goto-char (point-min))
1965 (setq length (count-lines 1 (point-max))) 1944 (setq length (count-lines 1 (point-max)))
1966 (setq parts (/ length gnus-uu-post-length)) 1945 (setq parts (/ length gnus-uu-post-length))
1967 (when (not (< (% length gnus-uu-post-length) 4)) 1946 (unless (< (% length gnus-uu-post-length) 4)
1968 (setq parts (1+ parts)))) 1947 (incf parts)))
1969 1948
1970 (when gnus-uu-post-separate-description 1949 (when gnus-uu-post-separate-description
1971 (forward-line -1)) 1950 (forward-line -1))
1972 (kill-region (point) (point-max)) 1951 (delete-region (point) (point-max))
1973 1952
1974 (goto-char (point-min)) 1953 (goto-char (point-min))
1975 (re-search-forward 1954 (re-search-forward
1976 (concat "^" (regexp-quote mail-header-separator) "$") nil t) 1955 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
1977 (beginning-of-line) 1956 (beginning-of-line)
1978 (setq header (buffer-substring 1 (point))) 1957 (setq header (buffer-substring 1 (point)))
1979 1958
1980 (goto-char (point-min)) 1959 (goto-char (point-min))
1981 (if (not gnus-uu-post-separate-description) 1960 (when gnus-uu-post-separate-description
1982 () 1961 (when (re-search-forward "^Subject: " nil t)
1983 (when (and (not threaded) (re-search-forward "^Subject: " nil t))
1984 (end-of-line) 1962 (end-of-line)
1985 (insert (format " (0/%d)" parts))) 1963 (insert (format " (0/%d)" parts)))
1986 (message-send)) 1964 (save-excursion
1965 (message-send))
1966 (setq gnus-uu-post-message-id (message-fetch-field "message-id")))
1987 1967
1988 (save-excursion 1968 (save-excursion
1989 (setq i 1) 1969 (setq i 1)
1990 (setq beg 1) 1970 (setq beg 1)
1991 (while (not (> i parts)) 1971 (while (not (> i parts))
1992 (set-buffer (get-buffer-create send-buffer-name)) 1972 (set-buffer (get-buffer-create send-buffer-name))
1993 (erase-buffer) 1973 (erase-buffer)
1994 (insert header) 1974 (insert header)
1995 (when (and threaded gnus-uu-post-message-id) 1975 (when (and threaded gnus-uu-post-message-id)
1996 (insert (format "References: %s\n" gnus-uu-post-message-id))) 1976 (insert "References: " gnus-uu-post-message-id "\n"))
1997 (insert separator) 1977 (insert separator)
1998 (setq whole-len 1978 (setq whole-len
1999 (- 62 (length (format top-string "" file-name i parts "")))) 1979 (- 62 (length (format top-string "" file-name i parts ""))))
2000 (when (> 1 (setq minlen (/ whole-len 2))) 1980 (when (> 1 (setq minlen (/ whole-len 2)))
2001 (setq minlen 1)) 1981 (setq minlen 1))
2006 file-name i parts 1986 file-name i parts
2007 (make-string 1987 (make-string
2008 (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) 1988 (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
2009 1989
2010 (goto-char (point-min)) 1990 (goto-char (point-min))
2011 (if (not (re-search-forward "^Subject: " nil t)) 1991 (when (re-search-forward "^Subject: " nil t)
2012 () 1992 (end-of-line)
2013 (if (not threaded) 1993 (insert (format " (%d/%d)" i parts)))
2014 (progn
2015 (end-of-line)
2016 (insert (format " (%d/%d)" i parts)))
2017 (when (or (and (= i 2) gnus-uu-post-separate-description)
2018 (and (= i 1) (not gnus-uu-post-separate-description)))
2019 (replace-match "Subject: Re: "))))
2020 1994
2021 (goto-char (point-max)) 1995 (goto-char (point-max))
2022 (save-excursion 1996 (save-excursion
2023 (set-buffer uubuf) 1997 (set-buffer uubuf)
2024 (goto-char beg) 1998 (goto-char beg)
2027 (forward-line gnus-uu-post-length)) 2001 (forward-line gnus-uu-post-length))
2028 (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) 2002 (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
2029 (forward-line -4)) 2003 (forward-line -4))
2030 (setq end (point))) 2004 (setq end (point)))
2031 (insert-buffer-substring uubuf beg end) 2005 (insert-buffer-substring uubuf beg end)
2032 (insert beg-line) 2006 (insert beg-line "\n")
2033 (insert "\n")
2034 (setq beg end) 2007 (setq beg end)
2035 (setq i (1+ i)) 2008 (incf i)
2036 (goto-char (point-min)) 2009 (goto-char (point-min))
2037 (re-search-forward 2010 (re-search-forward
2038 (concat "^" (regexp-quote mail-header-separator) "$") nil t) 2011 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2039 (beginning-of-line) 2012 (beginning-of-line)
2040 (forward-line 2) 2013 (forward-line 2)
2044 (replace-match "") 2017 (replace-match "")
2045 (forward-line 1)) 2018 (forward-line 1))
2046 (insert beg-line) 2019 (insert beg-line)
2047 (insert "\n") 2020 (insert "\n")
2048 (let (message-sent-message-via) 2021 (let (message-sent-message-via)
2049 (message-send)))) 2022 (save-excursion
2050 2023 (message-send))
2051 (when (setq buf (get-buffer send-buffer-name)) 2024 (setq gnus-uu-post-message-id
2052 (kill-buffer buf)) 2025 (concat (message-fetch-field "references") " "
2053 (when (setq buf (get-buffer encoded-buffer-name)) 2026 (message-fetch-field "message-id"))))))
2054 (kill-buffer buf)) 2027
2028 (gnus-kill-buffer send-buffer-name)
2029 (gnus-kill-buffer encoded-buffer-name)
2055 2030
2056 (when (not gnus-uu-post-separate-description) 2031 (when (not gnus-uu-post-separate-description)
2057 (set-buffer-modified-p nil) 2032 (set-buffer-modified-p nil)
2058 (when (fboundp 'bury-buffer) 2033 (when (fboundp 'bury-buffer)
2059 (bury-buffer))))) 2034 (bury-buffer)))))