(eval-and-compile
(defalias 'fill-flowed-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
+ (if (fboundp 'point-at-bol)
+ 'point-at-bol
+ 'line-beginning-position))
- (defalias 'fill-flowed-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
+ (defalias 'fill-flowed-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position)))
(defun fill-flowed (&optional buffer)
(save-excursion
(save-excursion
(unless (eobp)
(forward-char 1)
- (looking-at (format "^\\(%s\\)\\([^>]\\)" (or quote " ?"))))))
+ (looking-at (format "^\\(%s\\)\\([^>]\\)"
+ (or quote " ?"))))))
(save-excursion
(replace-match (if (string= (match-string 2) " ")
"" "\\2")))
(background light))
(:foreground "indianred4" :italic t))
(t
- (:italic t))) "Face used for displaying header content."
+ (:italic t)))
+ "Face used for displaying header content."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
(gnus-article-show-hidden-text 'boring-headers)
(when (eq 1 (point-min))
(set-window-start (get-buffer-window (current-buffer)) 1)))
- (unless gnus-inhibit-hiding
- (save-excursion
- (save-restriction
- (let ((inhibit-read-only t)
- (case-fold-search t)
- (max (1+ (length gnus-sorted-header-list)))
- (ignored (when (not gnus-visible-headers)
- (cond ((stringp gnus-ignored-headers)
- gnus-ignored-headers)
- ((listp gnus-ignored-headers)
- (mapconcat 'identity gnus-ignored-headers
- "\\|")))))
- (visible
- (cond ((stringp gnus-visible-headers)
- gnus-visible-headers)
- ((and gnus-visible-headers
- (listp gnus-visible-headers))
- (mapconcat 'identity gnus-visible-headers "\\|"))))
- (inhibit-point-motion-hooks t)
- beg)
- ;; First we narrow to just the headers.
- (article-narrow-to-head)
- ;; Hide any "From " lines at the beginning of (mail) articles.
- (while (looking-at "From ")
- (forward-line 1))
- (unless (bobp)
- (if delete
- (delete-region (point-min) (point))
- (gnus-article-hide-text (point-min) (point)
- (nconc (list 'article-type 'headers)
- gnus-hidden-properties))))
- ;; Then treat the rest of the header lines.
- ;; Then we use the two regular expressions
- ;; `gnus-ignored-headers' and `gnus-visible-headers' to
- ;; select which header lines is to remain visible in the
- ;; article buffer.
- (while (re-search-forward "^[^ \t:]*:" nil t)
- (beginning-of-line)
- ;; Mark the rank of the header.
- (put-text-property
- (point) (1+ (point)) 'message-rank
- (if (or (and visible (looking-at visible))
- (and ignored
- (not (looking-at ignored))))
- (gnus-article-header-rank)
- (+ 2 max)))
- (forward-line 1))
- (message-sort-headers-1)
- (when (setq beg (text-property-any
- (point-min) (point-max) 'message-rank (+ 2 max)))
- ;; We delete or make invisible the unwanted headers.
- (push 'headers gnus-article-wash-types)
- (if delete
- (progn
- (add-text-properties
- (point-min) (+ 5 (point-min))
- '(article-type headers dummy-invisible t))
- (delete-region beg (point-max)))
- (gnus-article-hide-text-type beg (point-max) 'headers))))))))
+ (unless gnus-inhibit-hiding
+ (save-excursion
+ (save-restriction
+ (let ((inhibit-read-only t)
+ (case-fold-search t)
+ (max (1+ (length gnus-sorted-header-list)))
+ (ignored (when (not gnus-visible-headers)
+ (cond ((stringp gnus-ignored-headers)
+ gnus-ignored-headers)
+ ((listp gnus-ignored-headers)
+ (mapconcat 'identity gnus-ignored-headers
+ "\\|")))))
+ (visible
+ (cond ((stringp gnus-visible-headers)
+ gnus-visible-headers)
+ ((and gnus-visible-headers
+ (listp gnus-visible-headers))
+ (mapconcat 'identity gnus-visible-headers "\\|"))))
+ (inhibit-point-motion-hooks t)
+ beg)
+ ;; First we narrow to just the headers.
+ (article-narrow-to-head)
+ ;; Hide any "From " lines at the beginning of (mail) articles.
+ (while (looking-at "From ")
+ (forward-line 1))
+ (unless (bobp)
+ (if delete
+ (delete-region (point-min) (point))
+ (gnus-article-hide-text (point-min) (point)
+ (nconc (list 'article-type 'headers)
+ gnus-hidden-properties))))
+ ;; Then treat the rest of the header lines.
+ ;; Then we use the two regular expressions
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' to
+ ;; select which header lines is to remain visible in the
+ ;; article buffer.
+ (while (re-search-forward "^[^ \t:]*:" nil t)
+ (beginning-of-line)
+ ;; Mark the rank of the header.
+ (put-text-property
+ (point) (1+ (point)) 'message-rank
+ (if (or (and visible (looking-at visible))
+ (and ignored
+ (not (looking-at ignored))))
+ (gnus-article-header-rank)
+ (+ 2 max)))
+ (forward-line 1))
+ (message-sort-headers-1)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'message-rank (+ 2 max)))
+ ;; We delete or make invisible the unwanted headers.
+ (push 'headers gnus-article-wash-types)
+ (if delete
+ (progn
+ (add-text-properties
+ (point-min) (+ 5 (point-min))
+ '(article-type headers dummy-invisible t))
+ (delete-region beg (point-max)))
+ (gnus-article-hide-text-type beg (point-max) 'headers))))))))
)
(defun article-hide-boring-headers (&optional arg)
(error))
gnus-newsgroup-ignored-charsets))
ct cte ctl charset format)
- (save-excursion
- (save-restriction
- (article-narrow-to-head)
- (setq ct (message-fetch-field "Content-Type" t)
- cte (message-fetch-field "Content-Transfer-Encoding" t)
- ctl (and ct (ignore-errors
- (mail-header-parse-content-type ct)))
- charset (cond
- (prompt
- (mm-read-coding-system "Charset to decode: "))
- (ctl
- (mail-content-type-get ctl 'charset)))
- format (and ctl (mail-content-type-get ctl 'format)))
- (when cte
- (setq cte (mail-header-strip cte)))
- (if (and ctl (not (string-match "/" (car ctl))))
- (setq ctl nil))
- (goto-char (point-max)))
- (forward-line 1)
- (save-restriction
- (narrow-to-region (point) (point-max))
- (when (and (eq mail-parse-charset 'gnus-decoded)
- (eq (mm-body-7-or-8) '8bit))
- ;; The text code could have been decoded.
- (setq charset mail-parse-charset))
- (when (and (or (not ctl)
- (equal (car ctl) "text/plain"))
- (not format)) ;; article with format will decode later.
- (mm-decode-body
- charset (and cte (intern (downcase
- (gnus-strip-whitespace cte))))
- (car ctl)))))))
+ (save-excursion
+ (save-restriction
+ (article-narrow-to-head)
+ (setq ct (message-fetch-field "Content-Type" t)
+ cte (message-fetch-field "Content-Transfer-Encoding" t)
+ ctl (and ct (ignore-errors
+ (mail-header-parse-content-type ct)))
+ charset (cond
+ (prompt
+ (mm-read-coding-system "Charset to decode: "))
+ (ctl
+ (mail-content-type-get ctl 'charset)))
+ format (and ctl (mail-content-type-get ctl 'format)))
+ (when cte
+ (setq cte (mail-header-strip cte)))
+ (if (and ctl (not (string-match "/" (car ctl))))
+ (setq ctl nil))
+ (goto-char (point-max)))
+ (forward-line 1)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (when (and (eq mail-parse-charset 'gnus-decoded)
+ (eq (mm-body-7-or-8) '8bit))
+ ;; The text code could have been decoded.
+ (setq charset mail-parse-charset))
+ (when (and (or (not ctl)
+ (equal (car ctl) "text/plain"))
+ (not format)) ;; article with format will decode later.
+ (mm-decode-body
+ charset (and cte (intern (downcase
+ (gnus-strip-whitespace cte))))
+ (car ctl)))))))
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
(re-search-forward "^X-Sent:[ \t]" nil t))
(setq bface (get-text-property (gnus-point-at-bol) 'face)
date (or (get-text-property (gnus-point-at-bol)
- 'original-date)
- date)
+ 'original-date)
+ date)
eface (get-text-property (1- (gnus-point-at-eol))
'face)))
(let ((buffer-read-only nil))
(format "%02d" (nth 2 dtime))
":"
(format "%02d" (nth 1 dtime)))))))
- (error
- (format "Date: %s (from Oort)" date))))
+ (error
+ (format "Date: %s (from Oort)" date))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(car (push result file-name-history)))))))
;; Create the directory.
(gnus-make-directory (file-name-directory file))
- ;; If we have read a directory, we append the default file name.
+ ;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
(setq file (expand-file-name (file-name-nondirectory
default-name)
gfunc (intern (format "gnus-%s" func))))
(defalias gfunc
(if (fboundp afunc)
- `(lambda (&optional interactive &rest args)
- ,(documentation afunc t)
- (interactive (list t))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (if interactive
- (call-interactively ',afunc)
- (apply ',afunc args))))))))
+ `(lambda (&optional interactive &rest args)
+ ,(documentation afunc t)
+ (interactive (list t))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (if interactive
+ (call-interactively ',afunc)
+ (apply ',afunc args))))))))
'(article-hide-headers
article-verify-x-pgp-sig
article-hide-boring-headers
(set-buffer gnus-summary-buffer)
(gnus-article-edit-article
`(lambda ()
- (erase-buffer)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
- (mbl mml-buffer-list))
- (setq mml-buffer-list nil)
- (insert-buffer gnus-original-article-buffer)
- (mime-to-mml gnus-article-mime-handles)
- (setq gnus-article-mime-handles nil)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
- ;; LOCAL argument of add-hook differs between GNU Emacs
- ;; and XEmacs. make-local-hook makes sure they are local.
- (make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+ (erase-buffer)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ (mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (insert-buffer gnus-original-article-buffer)
+ (mime-to-mml gnus-article-mime-handles)
+ (setq gnus-article-mime-handles nil)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ ;; LOCAL argument of add-hook differs between GNU Emacs
+ ;; and XEmacs. make-local-hook makes sure they are local.
+ (make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
`(lambda (no-highlight)
(let ((mail-parse-charset (or gnus-article-charset
',gnus-newsgroup-charset))
(mail-parse-ignored-charsets
(or gnus-article-ignored-charsets
',gnus-newsgroup-ignored-charsets)))
- (mml-to-mime)
- (mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
- 'mml-destroy-buffers t)
- (kill-local-variable 'mml-buffer-list))
+ (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)
(or (cdr (assq arg
gnus-summary-show-article-charset-alist))
(mm-read-coding-system "Charset: ")))
- (gnus-newsgroup-ignored-charsets 'gnus-all))
+ (gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-article-press-button)))))
(defun gnus-mime-externalize-part (&optional handle)
(setq cur (car pairs)
pairs (cdr pairs))
(if (not (string-match "=" cur))
- nil ; Grace
+ nil ; Grace
(setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
(if downcase
(string-match (car x) gnus-newsgroup-name))
(nconc gnus-decode-header-methods-cache
(list (cdr x))))))
- gnus-decode-header-methods))
+ gnus-decode-header-methods))
(let ((xlist gnus-decode-header-methods-cache))
(pop xlist)
(save-restriction
(error "The current newsgroup does not support article encrypt"))
(gnus-summary-show-article t)
(setq references
- (or (mail-header-references gnus-current-headers) ""))
+ (or (mail-header-references gnus-current-headers) ""))
(set-buffer gnus-article-buffer)
(let* ((buffer-read-only nil)
(headers
(let ((gnus-mime-security-button-pressed t)
(gnus-mime-security-button-line-format
(get-text-property (point) 'gnus-line-format))
- buffer-read-only)
+ buffer-read-only)
(forward-char -1)
(while (eq (get-text-property (point) 'gnus-line-format)
gnus-mime-security-button-line-format)
(delete-region (point)
(or (text-property-not-all
(point) (point-max)
- 'gnus-line-format
- gnus-mime-security-button-line-format)
+ 'gnus-line-format
+ gnus-mime-security-button-line-format)
(point-max)))
(gnus-insert-mime-security-button handle))
(if (gnus-buffer-live-p gnus-mime-security-details-buffer)
(expand-file-name file gnus-audio-directory))))
(when (file-exists-p sound-file)
(cond ((and gnus-audio-inline-sound
- (condition-case nil
- ;; Even if we have audio, we may fail with the
- ;; wrong sort of sound file.
- (progn (play-sound-file sound-file)
- t)
- (error nil))))
+ (condition-case nil
+ ;; Even if we have audio, we may fail with the
+ ;; wrong sort of sound file.
+ (progn (play-sound-file sound-file)
+ t)
+ (error nil))))
;; If we don't have built-in sound, or playing it failed,
;; try with external program.
((equal "wav" (file-name-extension sound-file))
(let ((record (gnus-bbdb/update-record t)))
(if record
(bbdb-display-records (list record))
- (error "unperson"))))
+ (error "unperson"))))
(defun gnus-bbdb/pop-up-bbdb-buffer (&optional offer-to-create)
(name (car data))
(net (car (cdr data)))
(record (and data
- (bbdb-search-simple name
+ (bbdb-search-simple
+ name
(if (and net bbdb-canonicalize-net-hook)
(bbdb-canonicalize-address net)
net))))
net)
name))
net from "**UNKNOWN**"))
- ;; GNUS can't cope with extra square-brackets appearing in the summary.
- (if (and name (string-match "[][]" name))
- (progn (setq name (copy-sequence name))
- (while (string-match "[][]" name)
- (aset name (match-beginning 0) ? ))))
- (setq string (format "%s%3d:%s"
- (if (and record gnus-bbdb/summary-mark-known-posters)
- (or (bbdb-record-getprop
- record bbdb-message-marker-field)
- "*")
- " ")
- lines (or name from))
- L (length string))
- (cond ((> L length) (substring string 0 length))
- ((< L length) (concat string (make-string (- length L) ? )))
- (t string))))
+ ;; GNUS can't cope with extra square-brackets appearing in the summary.
+ (if (and name (string-match "[][]" name))
+ (progn (setq name (copy-sequence name))
+ (while (string-match "[][]" name)
+ (aset name (match-beginning 0) ? ))))
+ (setq string (format "%s%3d:%s"
+ (if (and record gnus-bbdb/summary-mark-known-posters)
+ (or (bbdb-record-getprop
+ record bbdb-message-marker-field)
+ "*")
+ " ")
+ lines (or name from))
+ L (length string))
+ (cond ((> L length) (substring string 0 length))
+ ((< L length) (concat string (make-string (- length L) ? )))
+ (t string))))
(defun gnus-bbdb/summary-get-author (header)
"Given a Gnus message header, returns the appropriate piece of
(name (car data))
(net (car (cdr data)))
(record (and data
- (bbdb-search-simple name
+ (bbdb-search-simple
+ name
(if (and net bbdb-canonicalize-net-hook)
(bbdb-canonicalize-address net)
net)))))
file, with the advantage that it can keep up with multiple and changing
addresses better than the traditionally static global scorefile."
(list (list
- (condition-case nil
- (read (gnus-bbdb/score-as-text group))
- (error (setq gnus-bbdb/score-rebuild-alist t)
- (message "Problem building BBDB score table.")
- (ding) (sit-for 2)
- nil)))))
+ (condition-case nil
+ (read (gnus-bbdb/score-as-text group))
+ (error (setq gnus-bbdb/score-rebuild-alist t)
+ (message "Problem building BBDB score table.")
+ (ding) (sit-for 2)
+ nil)))))
(defun gnus-bbdb/score-as-text (group)
"Returns a SCORE file format string built from the BBDB."
(setq gnus-bbdb/score-default-internal
gnus-bbdb/score-default)
t))
- (not gnus-bbdb/score-alist)
- gnus-bbdb/score-rebuild-alist)
- (setq gnus-bbdb/score-rebuild-alist nil)
- (setq gnus-bbdb/score-alist
- (concat "((touched nil) (\"from\"\n"
- (mapconcat
- (lambda (rec)
- (let ((score (or (bbdb-record-getprop rec
- gnus-bbdb/score-field)
- gnus-bbdb/score-default))
- (net (bbdb-record-net rec)))
- (if (not (and score net)) nil
- (mapconcat
- (lambda (addr)
- (concat "(\"" addr "\" " score ")\n"))
- net ""))))
- (bbdb-records) "")
- "))"))))
+ (not gnus-bbdb/score-alist)
+ gnus-bbdb/score-rebuild-alist)
+ (setq gnus-bbdb/score-rebuild-alist nil)
+ (setq gnus-bbdb/score-alist
+ (concat "((touched nil) (\"from\"\n"
+ (mapconcat
+ (lambda (rec)
+ (let ((score (or (bbdb-record-getprop
+ rec
+ gnus-bbdb/score-field)
+ gnus-bbdb/score-default))
+ (net (bbdb-record-net rec)))
+ (if (not (and score net)) nil
+ (mapconcat
+ (lambda (addr)
+ (concat "(\"" addr "\" " score ")\n"))
+ net ""))))
+ (bbdb-records) "")
+ "))"))))
gnus-bbdb/score-alist)
(defun gnus-bbdb/extract-field-value-init ()
b)
(if (memq ident gnus-backlog-articles)
() ; It's already kept.
- ;; Remove the oldest article, if necessary.
+ ;; Remove the oldest article, if necessary.
(and (numberp gnus-keep-backlog)
(>= (length gnus-backlog-articles) gnus-keep-backlog)
- (gnus-backlog-remove-oldest-article))
+ (gnus-backlog-remove-oldest-article))
(push ident gnus-backlog-articles)
;; Insert the new article.
(save-excursion
(insert-buffer-substring buffer)
;; Tag the beginning of the article with the ident.
(if (> (point-max) b)
- (gnus-put-text-property b (1+ b) 'gnus-backlog ident)
+ (gnus-put-text-property b (1+ b) 'gnus-backlog ident)
(gnus-error 3 "Article %d is blank" number))))))))
(defun gnus-backlog-remove-oldest-article ()
?. ?_)))
;; Translate the first colon into a slash.
(when (string-match ":" group)
- (setq group (concat (substring group 0 (match-beginning 0))
- "/" (substring group (match-end 0)))))
+ (setq group (concat (substring group 0 (match-beginning 0))
+ "/" (substring group (match-end 0)))))
(nnheader-replace-chars-in-string group ?. ?/)))
t)
gnus-cache-directory))))
(gnus-set-format 'cited-closed-text-button t)
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- marks
- (inhibit-point-motion-hooks t)
- (props (nconc (list 'article-type 'cite)
- gnus-hidden-properties))
- (point (point-min))
- found beg end start)
- (while (setq point
- (text-property-any point (point-max)
- 'gnus-callback
- 'gnus-article-toggle-cited-text))
- (setq found t)
- (goto-char point)
- (gnus-article-toggle-cited-text
- (get-text-property point 'gnus-data) arg)
- (forward-line 1)
- (setq point (point)))
- (unless found
- (setq marks (gnus-dissect-cited-text))
- (while marks
- (setq beg nil
- end nil)
- (while (and marks (string= (cdar marks) ""))
- (setq marks (cdr marks)))
- (when marks
- (setq beg (caar marks)))
- (while (and marks (not (string= (cdar marks) "")))
- (setq marks (cdr marks)))
- (when marks
+ (let ((buffer-read-only nil)
+ marks
+ (inhibit-point-motion-hooks t)
+ (props (nconc (list 'article-type 'cite)
+ gnus-hidden-properties))
+ (point (point-min))
+ found beg end start)
+ (while (setq point
+ (text-property-any point (point-max)
+ 'gnus-callback
+ 'gnus-article-toggle-cited-text))
+ (setq found t)
+ (goto-char point)
+ (gnus-article-toggle-cited-text
+ (get-text-property point 'gnus-data) arg)
+ (forward-line 1)
+ (setq point (point)))
+ (unless found
+ (setq marks (gnus-dissect-cited-text))
+ (while marks
+ (setq beg nil
+ end nil)
+ (while (and marks (string= (cdar marks) ""))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq beg (caar marks)))
+ (while (and marks (not (string= (cdar marks) "")))
+ (setq marks (cdr marks)))
+ (when marks
(setq end (caar marks)))
- ;; Skip past lines we want to leave visible.
- (when (and beg end gnus-cited-lines-visible)
- (goto-char beg)
- (forward-line (if (consp gnus-cited-lines-visible)
- (car gnus-cited-lines-visible)
- gnus-cited-lines-visible))
- (if (>= (point) end)
- (setq beg nil)
- (setq beg (point-marker))
- (when (consp gnus-cited-lines-visible)
- (goto-char end)
- (forward-line (- (cdr gnus-cited-lines-visible)))
- (if (<= (point) beg)
- (setq beg nil)
+ ;; Skip past lines we want to leave visible.
+ (when (and beg end gnus-cited-lines-visible)
+ (goto-char beg)
+ (forward-line (if (consp gnus-cited-lines-visible)
+ (car gnus-cited-lines-visible)
+ gnus-cited-lines-visible))
+ (if (>= (point) end)
+ (setq beg nil)
+ (setq beg (point-marker))
+ (when (consp gnus-cited-lines-visible)
+ (goto-char end)
+ (forward-line (- (cdr gnus-cited-lines-visible)))
+ (if (<= (point) beg)
+ (setq beg nil)
(setq end (point-marker))))))
- (when (and beg end)
- ;; We use markers for the end-points to facilitate later
- ;; wrapping and mangling of text.
- (setq beg (set-marker (make-marker) beg)
- end (set-marker (make-marker) end))
- (gnus-add-text-properties-when 'article-type nil beg end props)
- (goto-char beg)
- (unless (save-excursion (search-backward "\n\n" nil t))
- (insert "\n"))
- (put-text-property
- (setq start (point-marker))
- (progn
+ (when (and beg end)
+ ;; We use markers for the end-points to facilitate later
+ ;; wrapping and mangling of text.
+ (setq beg (set-marker (make-marker) beg)
+ end (set-marker (make-marker) end))
+ (gnus-add-text-properties-when 'article-type nil beg end props)
+ (goto-char beg)
+ (unless (save-excursion (search-backward "\n\n" nil t))
+ (insert "\n"))
+ (put-text-property
+ (setq start (point-marker))
+ (progn
(gnus-article-add-button
(point)
(progn (eval gnus-cited-closed-text-button-line-format-spec)
`gnus-article-toggle-cited-text
(list (cons beg end) start))
(point))
- 'article-type 'annotation)
- (set-marker beg (point))))))))
+ 'article-type 'annotation)
+ (set-marker beg (point))))))))
(defun gnus-article-toggle-cited-text (args &optional arg)
"Toggle hiding the text in REGION.
((and (= unread 0)) .
gnus-group-news-low-empty-face)
(t .
- gnus-group-news-low-face))
+ gnus-group-news-low-face))
"*Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
- '(:help "Kill (remove) current group"))]
+ '(:help "Kill (remove) current group"))]
["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
["Describe" gnus-group-describe-group :active (gnus-group-group-name)
,@(if (featurep 'xemacs) nil
(> (prefix-numeric-value level) gnus-level-killed))
(gnus-get-killed-groups))
(funcall gnus-group-prepare-function
- (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
+ (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
(goto-char (point-min))
(gnus-group-position-point))
(gnus-configure-windows 'group t)
(when (and (gnus-buffer-live-p gnus-dribble-buffer)
(not (zerop (save-excursion
- (set-buffer gnus-dribble-buffer)
- (buffer-size)))))
+ (set-buffer gnus-dribble-buffer)
+ (buffer-size)))))
(gnus-dribble-enter
";;; Gnus was exited on purpose without saving the .newsrc files."))
(gnus-dribble-save)
(file-regular-p fname))
(mailcap-parse-mailcap fname))
(setq fnames (cdr fnames))))
- (setq mailcap-parsed-p t)))
+ (setq mailcap-parsed-p t)))
(defun mailcap-parse-mailcap (fname)
"Parse out the mailcap file specified by FNAME."
(setq mailcap-mime-data
(cons (cons major (list (cons minor info)))
mailcap-mime-data))
- (let ((cur-minor (assoc minor old-major)))
+ (let ((cur-minor (assoc minor old-major)))
(cond
((or (null cur-minor) ; New minor area, or
(assq 'test info)) ; Has a test, insert at beginning
;;;
(defvar mailcap-mime-extensions
- '(("" . "text/plain")
+ '(("" . "text/plain")
(".abs" . "audio/x-mpeg")
(".aif" . "audio/aiff")
(".aifc" . "audio/aiff")
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
:type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message"
+ :value message-this-is-mail)
+ (const :tag "News article"
+ :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
:group 'gnus-charset)
;;; Internal variables.
;; "A matter of trust"
;; "Modern Woman"
;; "Ahhhhhhh!!" ; 2.10b1
- "Cup of life" ; 2.20
+ "Cup of life" ; 2.20
;; "Code of silence"
)
;; fetch only mail for gnus-agent
(if (and (eq gnus-offline-news-fetch-method 'nnagent)
(eq gnus-offline-articles-to-fetch 'mail))
- (setq gnus-agent-handle-level gnus-offline-mail-group-level)))
+ (setq gnus-agent-handle-level gnus-offline-mail-group-level)))
;;
;; Change mail group level to handle only mail.
nnagent-version
nnspool-version))
(str (format "\n with %s" ver)))
- (gnus-offline-add-custom-header
- "X-Gnus-Offline-Backend:" (concat gnus-offline-header-string str)))))
+ (gnus-offline-add-custom-header
+ "X-Gnus-Offline-Backend:" (concat gnus-offline-header-string str)))))
\f
;;
(choice :tag ,(gnus-ofsetup-gettext 'param-save-passwd-1)
:value ,(if (memq 'mail-source-password-cache gnus-variable-list)
t
- nil)
+ nil)
(const :tag ,(gnus-ofsetup-gettext 'param-save-passwd-2) t)
(const :tag ,(gnus-ofsetup-gettext 'param-save-passwd-3) nil))
,(gnus-ofsetup-gettext 'param-save-passwd-4))
(const :format "" ,(nth 0 entry))
,(nth 1 entry)))
params)))
- (kill-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
- (switch-to-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
- (gnus-custom-mode)
- (widget-insert (gnus-ofsetup-gettext 'customize-1))
- (widget-create 'push-button
+ (kill-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
+ (switch-to-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
+ (gnus-custom-mode)
+ (widget-insert (gnus-ofsetup-gettext 'customize-1))
+ (widget-create 'push-button
:tag (gnus-ofsetup-gettext 'customize-2)
:help-echo (gnus-ofsetup-gettext 'customize-3)
:action 'gnus-ofsetup-customize-done)
- (widget-insert "\n\n")
- (make-local-variable 'gnus-ofsetup-params)
- (setq gnus-ofsetup-params
- (widget-create 'group
- `(set :inline t
- :greedy t
- :tag ,(gnus-ofsetup-gettext 'customize-4)
- :format "%t:\n%h%v"
- :doc ,(gnus-ofsetup-gettext 'customize-5)
- ,@types)))
-
- (widget-create 'info-link
- :help-echo (gnus-ofsetup-gettext 'customize-6)
- :tag "<Info> mail sources"
- (if (string-match "^ja" gnus-offline-lang)
- "(gnus-ja)Mail Sources"
- "(gnus)Mail Sources"))
-
- (use-local-map widget-keymap)
- (local-set-key "q" 'bury-buffer)
- (widget-setup)
- (goto-char (point-min))))
+ (widget-insert "\n\n")
+ (make-local-variable 'gnus-ofsetup-params)
+ (setq gnus-ofsetup-params
+ (widget-create 'group
+ `(set :inline t
+ :greedy t
+ :tag ,(gnus-ofsetup-gettext 'customize-4)
+ :format "%t:\n%h%v"
+ :doc ,(gnus-ofsetup-gettext 'customize-5)
+ ,@types)))
+
+ (widget-create 'info-link
+ :help-echo (gnus-ofsetup-gettext 'customize-6)
+ :tag "<Info> mail sources"
+ (if (string-match "^ja" gnus-offline-lang)
+ "(gnus-ja)Mail Sources"
+ "(gnus)Mail Sources"))
+
+ (use-local-map widget-keymap)
+ (local-set-key "q" 'bury-buffer)
+ (widget-setup)
+ (goto-char (point-min))))
(defun gnus-ofsetup-customize-done (&rest ignore)
"Apply changes and bury the buffer."
entries alist ofunc article last)
(when articles
(setq last (mail-header-number (caar (last articles))))
- ;; Not all backends support partial fetching. In that case,
+ ;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
(unless (gnus-check-backend-function
(and (string-match "^gnus-" (symbol-name request-func))
(widen)
(when (funcall request-func article gnus-newsgroup-name)
(goto-char (point-min))
- ;; If just parts of the article is to be searched, but the
- ;; backend didn't support partial fetching, we just narrow
+ ;; If just parts of the article is to be searched, but the
+ ;; backend didn't support partial fetching, we just narrow
;; to the relevant parts.
(when ofunc
(if (eq ofunc 'gnus-request-head)
;; Update expire date
(cond ((null date)) ;Permanent entry.
((and found gnus-update-score-entry-dates)
- ;Match, update date.
+ ;Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
((and expire (< date expire)) ;Old entry, remove.
(gnus-group-level
(gnus-group-prefixed-name (car group)
method)))))
- (cond
- ((<= level gnus-level-subscribed) ? )
- ((<= level gnus-level-unsubscribed) ?U)
- ((= level gnus-level-zombie) ?Z)
- (t ?K)))
+ (cond
+ ((<= level gnus-level-subscribed) ? )
+ ((<= level gnus-level-unsubscribed) ?U)
+ ((= level gnus-level-zombie) ?Z)
+ (t ?K)))
(max 0 (- (1+ (cddr group)) (cadr group)))
(gnus-group-name-decode (car group) charset))))
(list 'gnus-group (car group)))
(gnus-get-function (gnus-server-to-method server)
'request-regenerate)
(error
- (error "This backend doesn't support regeneration")))
+ (error "This backend doesn't support regeneration")))
(gnus-message 5 "Requesting regeneration of %s..." server)
(unless (gnus-open-server server)
(error "Couldn't open server"))
(gnus-y-or-n-p
(if purpose
"Gnus exited on purpose without saving; read auto-save file anyway? "
- "Gnus auto-save file exists. Do you want to read it? ")))
+ "Gnus auto-save file exists. Do you want to read it? ")))
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
(while variables
(when (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (insert "(setq " (symbol-name variable) " '")
- (gnus-prin1 (symbol-value variable))
- (insert ")\n")))))
+ (insert "(setq " (symbol-name variable) " '")
+ (gnus-prin1 (symbol-value variable))
+ (insert ")\n")))))
(defun gnus-strip-killed-list ()
"Return the killed list minus the groups that match `gnus-save-killed-list'."
((= mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
((and (> score default-high) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
+ gnus-undownloaded-mark)))
. gnus-summary-high-unread-face)
((and (< score default-low) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
+ gnus-undownloaded-mark)))
. gnus-summary-low-unread-face)
((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
(memq article gnus-newsgroup-unreads))
(if (not (keymapp gnus-summary-article-menu))
(easy-menu-define
- gnus-article-commands-menu gnus-article-mode-map ""
- (cons "Commands" innards))
+ 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))
(gnus-id-to-thread (gnus-root-id id)))))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
- (gnus-summary-limit-include-matching-articles
- "subject"
- (regexp-quote (gnus-simplify-subject-re
- (mail-header-subject (gnus-id-to-header id)))))
+ (gnus-summary-limit-include-matching-articles
+ "subject"
+ (regexp-quote (gnus-simplify-subject-re
+ (mail-header-subject (gnus-id-to-header id)))))
(gnus-summary-position-point))))
(defun gnus-summary-limit-include-matching-articles (header regexp)
(error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
(prefix (if (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)
+ 'request-move-article gnus-newsgroup-name)
(gnus-group-real-prefix gnus-newsgroup-name)
""))
(names '((move "Move" "Moving")
(while (and
(> n 0)
(if unmark
- (gnus-summary-remove-process-mark
- (gnus-summary-article-number))
+ (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
(gnus-summary-set-process-mark (gnus-summary-article-number)))
(zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
(setq n (1- n)))
(gnus-summary-mark-article gnus-current-article gnus-read-mark))))
(defun gnus-summary-mark-unread-as-ticked ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-summary-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
(when (and gnus-fetch-old-headers
(eq gnus-headers-retrieved-by 'nov))
(if (eq gnus-fetch-old-headers 'invisible)
- (gnus-build-all-threads)
+ (gnus-build-all-threads)
(gnus-build-old-threads)))
;; Let the Gnus agent mark articles as read.
(when gnus-agent
regexp))
(when (or gnus-group-listed-groups
- (and (>= level gnus-level-killed)
- (<= lowest gnus-level-killed)))
+ (and (>= level gnus-level-killed)
+ (<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
(setq gnus-killed-list (sort gnus-killed-list 'string<))
gnus-level-killed ?K regexp)
(article 0.5)
(message 1.0 point)))
(display-term
- (vertical 1.0
- ("*display*" 1.0))))
+ (vertical 1.0
+ ("*display*" 1.0))))
"Window configuration for all possible Gnus buffers.
See the Gnus manual for an explanation of the syntax used.")
(defalias 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
(defalias 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
(defalias 'gnus-appt-select-lowest-window
- 'gnus-xmas-appt-select-lowest-window)
+ 'gnus-xmas-appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'character-to-event)
(defalias 'gnus-mode-line-buffer-identification
- 'gnus-xmas-mode-line-buffer-identification)
+ 'gnus-xmas-mode-line-buffer-identification)
(defalias 'gnus-key-press-event-p 'key-press-event-p)
(defalias 'gnus-region-active-p 'region-active-p)
(defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
(defun gnus-xmas-mailing-list-menu-add ()
(gnus-xmas-menu-add mailing-list
- gnus-mailing-list-menu))
+ gnus-mailing-list-menu))
(provide 'gnus-xmas)
ftp.seas.gwu.edu /pub/rtfm
rtfm.mit.edu /pub/usenet
Europe: ftp.uni-paderborn.de /pub/FAQ
- src.doc.ic.ac.uk /usenet/news-FAQS
+ src.doc.ic.ac.uk /usenet/news-FAQS
ftp.sunet.se /pub/usenet
- sunsite.auc.dk /pub/usenet
+ sunsite.auc.dk /pub/usenet
Asia: nctuccca.edu.tw /USENET/FAQ
hwarang.postech.ac.kr /pub/usenet
ftp.hk.super.net /mirror/faqs"
:function-document
"Return GROUP's to-address."
:variable-document
- "*Alist of group regexps and correspondent to-addresses."
- :parameter-type '(gnus-email-address :tag "To Address")
- :parameter-document "\
+ "*Alist of group regexps and correspondent to-addresses."
+ :parameter-type '(gnus-email-address :tag "To Address")
+ :parameter-document "\
This will be used when doing followups and posts.
This is primarily useful in mail groups that represent closed
:variable gnus-auto-expirable-newsgroups
:variable-default nil
:variable-document
- "*Groups in which to automatically mark read articles as expirable.
+ "*Groups in which to automatically mark read articles as expirable.
If non-nil, this should be a regexp that should match all groups in
which to perform auto-expiry. This only makes sense for mail groups."
- :variable-group nnmail-expire
- :variable-type '(choice (const nil)
- regexp)
- :parameter-type '(const :tag "Automatic Expire" t)
- :parameter-document
- "All articles that are read will be marked as expirable.")
+ :variable-group nnmail-expire
+ :variable-type '(choice (const nil)
+ regexp)
+ :parameter-type '(const :tag "Automatic Expire" t)
+ :parameter-document
+ "All articles that are read will be marked as expirable.")
(gnus-define-group-parameter
total-expire
expiring - which means that all read articles will be deleted after
\(say) one week. (This only goes for mail groups and the like, of
course.)"
- :variable-group nnmail-expire
- :variable-type '(choice (const nil)
- regexp)
- :parameter-type '(const :tag "Total Expire" t)
- :parameter-document
- "All read articles will be put through the expiry process
+ :variable-group nnmail-expire
+ :variable-type '(choice (const nil)
+ regexp)
+ :parameter-type '(const :tag "Total Expire" t)
+ :parameter-document
+ "All read articles will be put through the expiry process
This happens even if they are not marked as expirable.
Use with caution.")
("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
(".*" iso-8859-1))
:variable-document
- "Alist of regexps (to match group names) and default charsets to be used when reading."
- :variable-group gnus-charset
- :variable-type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
- :parameter-type '(symbol :tag "Charset")
- :parameter-document "\
+ "Alist of regexps (to match group names) and default charsets to be used when reading."
+ :variable-group gnus-charset
+ :variable-type '(repeat (list (regexp :tag "Group")
+ (symbol :tag "Charset")))
+ :parameter-type '(symbol :tag "Charset")
+ :parameter-document "\
The default charset to use in the group.")
(defcustom gnus-group-uncollapsed-levels 1
(progn
(message "imap: Opening SSL connection with `%s'...done" cmd)
done)
- (message "imap: Opening SSL connection with `%s'...failed" cmd)
+ (message "imap: Opening SSL connection with `%s'...failed" cmd)
nil)))
(defun imap-network-p (buffer)
;; resp-cond-bye = "BYE" SP resp-text
;;
;; mailbox-data = "FLAGS" SP flag-list /
-;; "LIST" SP mailbox-list /
+;; "LIST" SP mailbox-list /
;; "LSUB" SP mailbox-list /
-;; "SEARCH" *(SP nz-number) /
+;; "SEARCH" *(SP nz-number) /
;; "STATUS" SP mailbox SP "("
-;; [status-att SP number *(SP status-att SP number)] ")" /
+;; [status-att SP number *(SP status-att SP number)] ")" /
;; number SP "EXISTS" /
-;; number SP "RECENT"
+;; number SP "RECENT"
;;
;; message-data = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
;;
;; resp-text-code = "ALERT" /
;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
;; "NEWNAME" SP string SP string /
-;; "PARSE" /
+;; "PARSE" /
;; "PERMANENTFLAGS" SP "("
;; [flag-perm *(SP flag-perm)] ")" /
;; "READ-ONLY" /
-;; "READ-WRITE" /
-;; "TRYCREATE" /
+;; "READ-WRITE" /
+;; "TRYCREATE" /
;; "UIDNEXT" SP nz-number /
-;; "UIDVALIDITY" SP nz-number /
+;; "UIDVALIDITY" SP nz-number /
;; "UNSEEN" SP nz-number /
;; resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
;;
;; mailbox-data = ...
;; "STATUS" SP mailbox SP "("
-;; [status-att SP number
+;; [status-att SP number
;; *(SP status-att SP number)] ")"
;; ...
;;
(eval-when-compile
(mapcar (lambda (a)
(list 'const (car a)))
- imap-authenticator-alist)))
+ imap-authenticator-alist)))
(defconst mail-source-imap-streams
(eval-when-compile
(mapcar (lambda (a)
(list 'const (car a)))
- imap-stream-alist)))
+ imap-stream-alist)))
(defcustom mail-sources nil
"*Where the mail backends will look for incoming mail.
(const :format "" webmail)
(checklist :tag "Options" :greedy t
(group :inline t
- (const :format "" :value :subtype)
- ;; Should be generated from
- ;; `webmail-type-definition', but we
- ;; can't require webmail without W3.
- (choice :tag "Subtype"
- :value hotmail
- (const hotmail)
- (const yahoo)
- (const netaddress)
- (const netscape)
- (const my-deja)))
+ (const :format "" :value :subtype)
+ ;; Should be generated from
+ ;; `webmail-type-definition', but we
+ ;; can't require webmail without W3.
+ (choice :tag "Subtype"
+ :value hotmail
+ (const hotmail)
+ (const yahoo)
+ (const netaddress)
+ (const netscape)
+ (const my-deja)))
(group :inline t
(const :format "" :value :user)
(string :tag "User"))
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(goto-char (point-min))
-;;; ;; Unix mail format
+;;; ;; Unix mail format
;;; (unless (looking-at "\n*From ")
;;; (insert "From maildir "
;;; (current-time-string) "\n"))
;;; (while (re-search-forward "^From " nil t)
;;; (replace-match ">From "))
-;;; (goto-char (point-max))
+;;; (goto-char (point-max))
;;; (insert "\n\n")
;; MMDF mail format
(insert "\001\001\001\001\n"))
(if not-break
(while (and (not (eobp))
(not (looking-at message-cite-prefix-regexp))
- (looking-at paragraph-start))
+ (looking-at paragraph-start))
(forward-line 1)))
;; Find the prefix
(when (looking-at message-cite-prefix-regexp)
(insert quoted leading-space)))
(if quoted
(let* ((adaptive-fill-regexp
- (regexp-quote (concat quoted leading-space)))
+ (regexp-quote (concat quoted leading-space)))
(adaptive-fill-first-line-regexp
adaptive-fill-regexp ))
(fill-paragraph arg))
(if (= (length errors) 1) "this" "these")
(if (= (length errors) 1) "" "s")
(mapconcat 'identity errors ", ")))))))
- ;; Check the Newsgroups & Followup-To headers for syntax errors.
- (message-check 'valid-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error)
- (while (and headers (not error))
- (when (setq header (mail-fetch-field (car headers)))
- (if (or
- (not
- (string-match
- "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
- header))
- (memq
- nil (mapcar
- (lambda (g)
- (not (string-match "\\.\\'\\|\\.\\." g)))
- (message-tokenize-header header ","))))
- (setq error t)))
- (unless error
- (pop headers)))
- (if (not error)
- t
- (y-or-n-p
- (format "The %s header looks odd: \"%s\". Really post? "
- (car headers) header)))))
- (message-check 'repeated-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error groups group)
- (while (and headers
- (not error))
- (when (setq header (mail-fetch-field (pop headers)))
- (setq groups (message-tokenize-header header ","))
- (while (setq group (pop groups))
- (when (member group groups)
- (setq error group
- groups nil)))))
- (if (not error)
- t
- (y-or-n-p
- (format "Group %s is repeated in headers. Really post? " error)))))
- ;; Check the From header.
- (message-check 'from
- (let* ((case-fold-search t)
- (from (message-fetch-field "from"))
- ad)
- (cond
- ((not from)
- (message "There is no From line. Posting is denied.")
- nil)
- ((or (not (string-match
- "@[^\\.]*\\."
- (setq ad (nth 1 (mail-extract-address-components
- from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
- (string-match "\\.$" ad) ;larsi@ifi.uio.
- (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
- (string-match "(.*).*(.*)" from)) ;(lars) (lars)
- (message
- "Denied posting -- the From looks strange: \"%s\"." from)
- nil)
- (t t))))
- ;; Check the Reply-To header.
- (message-check 'reply-to
- (let* ((case-fold-search t)
- (reply-to (message-fetch-field "reply-to"))
- ad)
- (cond
- ((not reply-to)
- t)
- ((string-match "," reply-to)
- (y-or-n-p
- (format "Multiple Reply-To addresses: \"%s\". Really post? "
- reply-to)))
- ((or (not (string-match
- "@[^\\.]*\\."
- (setq ad (nth 1 (mail-extract-address-components
- reply-to))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
- (string-match "\\.$" ad) ;larsi@ifi.uio.
- (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
- (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
- (y-or-n-p
- (format
- "The Reply-To looks strange: \"%s\". Really post? "
- reply-to)))
- (t t))))))
+ ;; Check the Newsgroups & Followup-To headers for syntax errors.
+ (message-check 'valid-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error)
+ (while (and headers (not error))
+ (when (setq header (mail-fetch-field (car headers)))
+ (if (or
+ (not
+ (string-match
+ "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
+ header))
+ (memq
+ nil (mapcar
+ (lambda (g)
+ (not (string-match "\\.\\'\\|\\.\\." g)))
+ (message-tokenize-header header ","))))
+ (setq error t)))
+ (unless error
+ (pop headers)))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "The %s header looks odd: \"%s\". Really post? "
+ (car headers) header)))))
+ (message-check 'repeated-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error groups group)
+ (while (and headers
+ (not error))
+ (when (setq header (mail-fetch-field (pop headers)))
+ (setq groups (message-tokenize-header header ","))
+ (while (setq group (pop groups))
+ (when (member group groups)
+ (setq error group
+ groups nil)))))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "Group %s is repeated in headers. Really post? " error)))))
+ ;; Check the From header.
+ (message-check 'from
+ (let* ((case-fold-search t)
+ (from (message-fetch-field "from"))
+ ad)
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ from))))) ;larsi@ifi
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-match "\\.$" ad) ;larsi@ifi.uio.
+ (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+ (string-match "(.*).*(.*)" from)) ;(lars) (lars)
+ (message
+ "Denied posting -- the From looks strange: \"%s\"." from)
+ nil)
+ (t t))))
+ ;; Check the Reply-To header.
+ (message-check 'reply-to
+ (let* ((case-fold-search t)
+ (reply-to (message-fetch-field "reply-to"))
+ ad)
+ (cond
+ ((not reply-to)
+ t)
+ ((string-match "," reply-to)
+ (y-or-n-p
+ (format "Multiple Reply-To addresses: \"%s\". Really post? "
+ reply-to)))
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ reply-to))))) ;larsi@ifi
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-match "\\.$" ad) ;larsi@ifi.uio.
+ (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+ (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
+ (y-or-n-p
+ (format
+ "The Reply-To looks strange: \"%s\". Really post? "
+ reply-to)))
+ (t t))))))
(defun message-check-news-body-syntax ()
(and
(insert (capitalize (symbol-name header))
": "
(std11-fill-msg-id-list-string
- (if (consp value) (car value) value))
+ (if (consp value) (car value) value))
"\n"))
(defun message-fill-header (header value)
(throw 'found t))))))
(defun mm-handle-set-external-undisplayer (handle function)
- "Set the undisplayer for this handle; postpone undisplaying of viewers
+ "Set the undisplayer for this handle; postpone undisplaying of viewers
for types in mm-keep-viewer-alive-types."
- (if (mm-keep-viewer-alive-p handle)
- (let ((new-handle (copy-sequence handle)))
- (mm-handle-set-undisplayer new-handle function)
- (mm-handle-set-undisplayer handle nil)
- (push new-handle mm-postponed-undisplay-list))
- (mm-handle-set-undisplayer handle function)))
+ (if (mm-keep-viewer-alive-p handle)
+ (let ((new-handle (copy-sequence handle)))
+ (mm-handle-set-undisplayer new-handle function)
+ (mm-handle-set-undisplayer handle nil)
+ (push new-handle mm-postponed-undisplay-list))
+ (mm-handle-set-undisplayer handle function)))
(defun mm-destroy-postponed-undisplay-list ()
(message "Destroying external MIME viewers")
(prog1
(setq spec
(ignore-errors
- ;; Avoid testing `make-glyph' since W3 may define
- ;; a bogus version of it.
+ ;; Avoid testing `make-glyph' since W3 may define
+ ;; a bogus version of it.
(if (fboundp 'create-image)
(create-image (buffer-string) (intern type) 'data-p)
(cond
(write-region (point-min) (point-max) file)
(make-glyph (list (cons 'x file))))
(ignore-errors
- (delete-file file)))))
+ (delete-file file)))))
(t
(make-glyph
(vector (intern type) :data (buffer-string))))))))
parts))
(defun mm-multiple-handles (handles)
- (and (listp (car handles))
- (> (length handles) 1)))
+ (and (listp (car handles))
+ (> (length handles) 1)))
(defun mm-merge-handles (handles1 handles2)
(append
(condition-case nil
;; This is only valid on XEmacs.
(mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
+ (remove-specifier
+ (face-property 'default prop) (current-buffer)))
'(background background-pixmap foreground))
(error nil))
(delete-region ,(point-min-marker) ,(point-max-marker))))))))))
(if ntotal
(if total
(unless (eq total ntotal)
- (error "The numbers of total are different"))
+ (error "The numbers of total are different"))
(setq total ntotal)))
(unless (< nn n)
(unless (eq nn n)
(condition-case nil
;; This is only valid on XEmacs.
(mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
+ (remove-specifier
+ (face-property 'default prop) (current-buffer)))
'(background background-pixmap foreground))
(error nil))
(delete-region ,(point-min-marker) ,(point-max-marker))))))))))
(progn
(setq mail-parse-mule-charset
(and (boundp 'current-language-environment)
- (car (last
- (assq 'charset
- (assoc current-language-environment
- language-info-alist))))))
+ (car (last
+ (assq 'charset
+ (assoc current-language-environment
+ language-info-alist))))))
(if (or (not mail-parse-mule-charset)
(eq mail-parse-mule-charset 'ascii))
(setq mail-parse-mule-charset
(fboundp 'set-buffer-multibyte)
(fboundp 'charsetp)
(not (charsetp 'eight-bit-control))) ;; For Emacs Mule 4 only.
- (let ((,buffer (current-buffer)))
- (unwind-protect
- (let (default-enable-multibyte-characters)
- (set-buffer-multibyte nil)
- ,@forms)
- (set-buffer ,buffer)
- (set-buffer-multibyte t)))
+ (let ((,buffer (current-buffer)))
+ (unwind-protect
+ (let (default-enable-multibyte-characters)
+ (set-buffer-multibyte nil)
+ ,@forms)
+ (set-buffer ,buffer)
+ (set-buffer-multibyte t)))
(let (default-enable-multibyte-characters)
,@forms))))
(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0)
:group 'gnus-article-mime)
(defvar mm-uu-pgp-beginning-signature
- "^-----BEGIN PGP SIGNATURE-----")
+ "^-----BEGIN PGP SIGNATURE-----")
(defvar mm-uu-beginning-regexp nil)
(if symbol (set-default symbol value))
(setq mm-uu-beginning-regexp nil)
(mapcar (lambda (entry)
- (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
- nil
- (setq mm-uu-beginning-regexp
- (concat mm-uu-beginning-regexp
- (if mm-uu-beginning-regexp "\\|")
- (mm-uu-beginning-regexp entry)))))
+ (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
+ nil
+ (setq mm-uu-beginning-regexp
+ (concat mm-uu-beginning-regexp
+ (if mm-uu-beginning-regexp "\\|")
+ (mm-uu-beginning-regexp entry)))))
mm-uu-type-alist))
(mm-uu-configure)
(re-search-forward
w3-meta-charset-content-type-regexp nil t)))
(setq charset
- (or (let ((bsubstr (buffer-substring-no-properties
- (match-beginning 2)
- (match-end 2))))
- (if (fboundp 'w3-coding-system-for-mime-charset)
- (w3-coding-system-for-mime-charset bsubstr)
- (mm-charset-to-coding-system bsubstr)))
- charset)))
+ (or (let ((bsubstr (buffer-substring-no-properties
+ (match-beginning 2)
+ (match-end 2))))
+ (if (fboundp 'w3-coding-system-for-mime-charset)
+ (w3-coding-system-for-mime-charset bsubstr)
+ (mm-charset-to-coding-system bsubstr)))
+ charset)))
(delete-region (point-min) (point-max))
(insert (mm-decode-string text charset))
(save-window-excursion
(mc-encrypt-generic
(or (message-options-get 'message-recipients)
(message-options-set 'message-recipients
- (mc-cleanup-recipient-headers
- (read-string "Recipients: "))))
+ (mc-cleanup-recipient-headers
+ (read-string "Recipients: "))))
nil nil nil
(message-options-get 'message-sender))))
(goto-char (point-min))
(deffoo nnagent-request-group (group &optional server dont-check)
(nnoo-parent-function 'nnagent 'nnml-request-group
- (list group (nnagent-server server) dont-check)))
+ (list group (nnagent-server server) dont-check)))
(deffoo nnagent-close-group (group &optional server)
(nnoo-parent-function 'nnagent 'nnml-close-group
- (list group (nnagent-server server))))
+ (list group (nnagent-server server))))
(deffoo nnagent-request-accept-article (group &optional server last)
(nnoo-parent-function 'nnagent 'nnml-request-accept-article
- (list group (nnagent-server server) last)))
+ (list group (nnagent-server server) last)))
(deffoo nnagent-request-article (id &optional group server buffer)
(nnoo-parent-function 'nnagent 'nnml-request-article
- (list id group (nnagent-server server) buffer)))
+ (list id group (nnagent-server server) buffer)))
(deffoo nnagent-request-create-group (group &optional server args)
(nnoo-parent-function 'nnagent 'nnml-request-create-group
- (list group (nnagent-server server) args)))
+ (list group (nnagent-server server) args)))
(deffoo nnagent-request-delete-group (group &optional force server)
(nnoo-parent-function 'nnagent 'nnml-request-delete-group
- (list group force (nnagent-server server))))
+ (list group force (nnagent-server server))))
(deffoo nnagent-request-expire-articles (articles group &optional server force)
(nnoo-parent-function 'nnagent 'nnml-request-expire-articles
- (list articles group (nnagent-server server) force)))
+ (list articles group (nnagent-server server) force)))
(deffoo nnagent-request-list (&optional server)
(nnoo-parent-function 'nnagent 'nnml-request-list
- (list (nnagent-server server))))
+ (list (nnagent-server server))))
(deffoo nnagent-request-list-newsgroups (&optional server)
(nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups
- (list (nnagent-server server))))
+ (list (nnagent-server server))))
(deffoo nnagent-request-move-article
(article group server accept-form &optional last)
(nnoo-parent-function 'nnagent 'nnml-request-move-article
- (list article group (nnagent-server server)
- accept-form last)))
+ (list article group (nnagent-server server)
+ accept-form last)))
(deffoo nnagent-request-rename-group (group new-name &optional server)
(nnoo-parent-function 'nnagent 'nnml-request-rename-group
- (list group new-name (nnagent-server server))))
+ (list group new-name (nnagent-server server))))
(deffoo nnagent-request-scan (&optional group server)
(nnoo-parent-function 'nnagent 'nnml-request-scan
- (list group (nnagent-server server))))
+ (list group (nnagent-server server))))
(deffoo nnagent-retrieve-headers (sequence &optional group server fetch-old)
(nnoo-parent-function 'nnagent 'nnml-retrieve-headers
- (list sequence group (nnagent-server server) fetch-old)))
+ (list sequence group (nnagent-server server) fetch-old)))
(deffoo nnagent-set-status (article name value &optional group server)
(nnoo-parent-function 'nnagent 'nnml-set-status
- (list article name value group (nnagent-server server))))
+ (list article name value group (nnagent-server server))))
(deffoo nnagent-server-opened (&optional server)
(nnoo-parent-function 'nnagent 'nnml-server-opened
(progn
(goto-char (point-min))
(or (and (search-forward "\n\n" nil t)
- (1- (point)))
+ (1- (point)))
(point-max)))
(point-max))
(goto-char (point-min))
(nnfolder-active-number nnfolder-current-group))))
(when novbuf
(let ((headers (nnfolder-parse-head newnum (point-min)
- (point-max))))
+ (point-max))))
(with-current-buffer novbuf
(goto-char (point-max))
(nnheader-insert-nov headers))))
"Parse the head of the current buffer."
(let ((buf (current-buffer))
chars)
- (save-excursion
- (unless b
- (setq b (if (nnmail-search-unix-mail-delim-backward)
- (point) (point-min)))
- (forward-line 1)
- (setq e (if (nnmail-search-unix-mail-delim)
- (point) (point-max))))
- (setq chars (- e b))
- (unless (zerop chars)
- (goto-char b)
- (if (search-forward "\n\n" e t) (setq e (1- (point)))))
- (with-temp-buffer
- (insert-buffer-substring buf b e)
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Remove any tabs; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((headers (nnheader-parse-head t)))
- (mail-header-set-chars headers chars)
- (mail-header-set-number headers number)
- headers)))))
+ (save-excursion
+ (unless b
+ (setq b (if (nnmail-search-unix-mail-delim-backward)
+ (point) (point-min)))
+ (forward-line 1)
+ (setq e (if (nnmail-search-unix-mail-delim)
+ (point) (point-max))))
+ (setq chars (- e b))
+ (unless (zerop chars)
+ (goto-char b)
+ (if (search-forward "\n\n" e t) (setq e (1- (point)))))
+ (with-temp-buffer
+ (insert-buffer-substring buf b e)
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;; Remove any tabs; they are too confusing.
+ (subst-char-in-region (point-min) (point-max) ?\t ? )
+ (let ((headers (nnheader-parse-head t)))
+ (mail-header-set-chars headers chars)
+ (mail-header-set-number headers number)
+ headers)))))
(defun nnfolder-add-nov (group article headers)
"Add a nov line for the GROUP base."
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
(with-current-buffer nntp-server-buffer
- (insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))))
+ (insert (format "\"%s\" %d %d y\n"
+ mbx (or (nth 2 info) 0)
+ (max 1 (or (nth 1 info) 1)))))))))))
(gnus-message 5 "nnimap: Generating active list%s...done"
(if (> (length server) 0) (concat " for " server) ""))
t))
(require 'trace)
(buffer-disable-undo (get-buffer-create nnimap-debug))
(mapcar (lambda (f) (trace-function-background f nnimap-debug))
- '(
- nnimap-possibly-change-server
- nnimap-verify-uidvalidity
- nnimap-find-minmax-uid
- nnimap-before-find-minmax-bugworkaround
- nnimap-possibly-change-group
- ;;nnimap-replace-whitespace
- nnimap-retrieve-headers-progress
- nnimap-retrieve-which-headers
- nnimap-group-overview-filename
- nnimap-retrieve-headers-from-file
- nnimap-retrieve-headers-from-server
- nnimap-retrieve-headers
- nnimap-open-connection
- nnimap-open-server
- nnimap-server-opened
- nnimap-close-server
- nnimap-request-close
- nnimap-status-message
- ;;nnimap-demule
- nnimap-request-article-part
- nnimap-request-article
- nnimap-request-head
- nnimap-request-body
- nnimap-request-group
- nnimap-close-group
- nnimap-pattern-to-list-arguments
- nnimap-request-list
- nnimap-request-post
- nnimap-retrieve-groups
- nnimap-request-update-info-internal
- nnimap-request-type
- nnimap-request-set-mark
- nnimap-split-to-groups
- nnimap-split-find-rule
- nnimap-split-find-inbox
- nnimap-split-articles
- nnimap-request-scan
- nnimap-request-newgroups
- nnimap-request-create-group
- nnimap-time-substract
- nnimap-date-days-ago
- nnimap-request-expire-articles-progress
- nnimap-request-expire-articles
- nnimap-request-move-article
- nnimap-request-accept-article
- nnimap-request-delete-group
- nnimap-request-rename-group
- gnus-group-nnimap-expunge
- gnus-group-nnimap-edit-acl
- gnus-group-nnimap-edit-acl-done
- nnimap-group-mode-hook
- nnimap-mark-to-predicate
- nnimap-mark-to-flag-1
- nnimap-mark-to-flag
- nnimap-mark-permanent-p
- nnimap-remassoc
- nnimap-update-alist-soft
- )))
+ '(
+ nnimap-possibly-change-server
+ nnimap-verify-uidvalidity
+ nnimap-find-minmax-uid
+ nnimap-before-find-minmax-bugworkaround
+ nnimap-possibly-change-group
+ ;;nnimap-replace-whitespace
+ nnimap-retrieve-headers-progress
+ nnimap-retrieve-which-headers
+ nnimap-group-overview-filename
+ nnimap-retrieve-headers-from-file
+ nnimap-retrieve-headers-from-server
+ nnimap-retrieve-headers
+ nnimap-open-connection
+ nnimap-open-server
+ nnimap-server-opened
+ nnimap-close-server
+ nnimap-request-close
+ nnimap-status-message
+ ;;nnimap-demule
+ nnimap-request-article-part
+ nnimap-request-article
+ nnimap-request-head
+ nnimap-request-body
+ nnimap-request-group
+ nnimap-close-group
+ nnimap-pattern-to-list-arguments
+ nnimap-request-list
+ nnimap-request-post
+ nnimap-retrieve-groups
+ nnimap-request-update-info-internal
+ nnimap-request-type
+ nnimap-request-set-mark
+ nnimap-split-to-groups
+ nnimap-split-find-rule
+ nnimap-split-find-inbox
+ nnimap-split-articles
+ nnimap-request-scan
+ nnimap-request-newgroups
+ nnimap-request-create-group
+ nnimap-time-substract
+ nnimap-date-days-ago
+ nnimap-request-expire-articles-progress
+ nnimap-request-expire-articles
+ nnimap-request-move-article
+ nnimap-request-accept-article
+ nnimap-request-delete-group
+ nnimap-request-rename-group
+ gnus-group-nnimap-expunge
+ gnus-group-nnimap-edit-acl
+ gnus-group-nnimap-edit-acl-done
+ nnimap-group-mode-hook
+ nnimap-mark-to-predicate
+ nnimap-mark-to-flag-1
+ nnimap-mark-to-flag
+ nnimap-mark-permanent-p
+ nnimap-remassoc
+ nnimap-update-alist-soft
+ )))
(provide 'nnimap)
(require 'nnoo)
(eval-when-compile
(ignore-errors
- (require 'nnweb)) ; requires W3
+ (require 'nnweb)) ; requires W3
(autoload 'url-insert-file-contents "nnweb"))
(nnoo-declare nnlistserv
receives one argument, the name of the group the message comes from.
The return value should be `delete' or a group name (a string)."
:version "21.1"
- :group 'nnmail-expire
- :type '(choice (const delete)
- (function :format "%v" nnmail-)
- string))
+ :group 'nnmail-expire
+ :type '(choice (const delete)
+ (function :format "%v" nnmail-)
+ string))
(defcustom nnmail-cache-accepted-message-ids nil
"If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
(nnmbox-request-article (car articles)
- newsgroup server
- (current-buffer))
+ newsgroup server
+ (current-buffer))
(let ((nnml-current-directory nil))
(nnmail-expiry-target-group
nnmail-expiry-target newsgroup))))
(mm-with-unibyte-buffer
(if (and nnrss-use-local
(file-exists-p (setq file (expand-file-name
- (nnrss-translate-file-chars
- (concat group ".xml"))
- nnrss-directory))))
+ (nnrss-translate-file-chars
+ (concat group ".xml"))
+ nnrss-directory))))
(insert-file-contents file)
(setq url (or (nth 2 (assoc group nnrss-server-data))
(second (assoc group nnrss-group-alist))))
(unless url
(setq url
- (read-string (format "RSS url of %s: " group "http://")))
+ (read-string (format "RSS url of %s: " group "http://")))
(let ((pair (assoc group nnrss-server-data)))
(if pair
(setcdr (cdr pair) (list url))
(unless (listp (car (setq xml (cddar xml))))
(setq xml nil)))
(dolist (item (nreverse xml))
- (when (and (listp item)
- (eq 'item (car item))
- (setq url (nnrss-node-text (assq 'link (cddr item))))
- (setq url (nnrss-decode-entities-unibyte-string url))
- (not (gnus-gethash url nnrss-group-hashtb)))
- (setq subject (nnrss-node-text (assq 'title (cddr item))))
- (setq extra (or (nnrss-node-text (assq 'description (cddr item)))
- (nnrss-node-text (assq 'dc:description (cddr item)))))
- (setq author (nnrss-node-text (assq 'dc:creator (cddr item))))
- (setq date (or (nnrss-node-text (assq 'dc:date (cddr item)))
- (message-make-date)))
- (push
- (list
- (incf nnrss-group-max)
- (current-time)
- url
- (and subject (nnrss-decode-entities-unibyte-string subject))
- (and author (nnrss-decode-entities-unibyte-string author))
- date
- (and extra (nnrss-decode-entities-unibyte-string extra)))
- nnrss-group-data)
- (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb)
- (setq changed t)))
+ (when (and (listp item)
+ (eq 'item (car item))
+ (setq url (nnrss-node-text (assq 'link (cddr item))))
+ (setq url (nnrss-decode-entities-unibyte-string url))
+ (not (gnus-gethash url nnrss-group-hashtb)))
+ (setq subject (nnrss-node-text (assq 'title (cddr item))))
+ (setq extra (or (nnrss-node-text (assq 'description (cddr item)))
+ (nnrss-node-text (assq 'dc:description (cddr item)))))
+ (setq author (nnrss-node-text (assq 'dc:creator (cddr item))))
+ (setq date (or (nnrss-node-text (assq 'dc:date (cddr item)))
+ (message-make-date)))
+ (push
+ (list
+ (incf nnrss-group-max)
+ (current-time)
+ url
+ (and subject (nnrss-decode-entities-unibyte-string subject))
+ (and author (nnrss-decode-entities-unibyte-string author))
+ date
+ (and extra (nnrss-decode-entities-unibyte-string extra)))
+ nnrss-group-data)
+ (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb)
+ (setq changed t)))
(when changed
(nnrss-save-group-data group server)
(let ((pair (assoc group nnrss-server-data)))
(dolist (elem nnrss-server-data)
(let ((url (or (nth 2 elem)
(second (assoc (car elem) nnrss-group-alist)))))
- (insert "$WGET -q -O \"$RSSDIR\"/'"
- (nnrss-translate-file-chars (concat (car elem) ".xml"))
- "' '" url "'\n"))))
+ (insert "$WGET -q -O \"$RSSDIR\"/'"
+ (nnrss-translate-file-chars (concat (car elem) ".xml"))
+ "' '" url "'\n"))))
(defun nnrss-translate-file-chars (name)
(let ((nnheader-file-name-translation-alist
(set-buffer nntp-server-buffer)
(erase-buffer)
(mm-with-unibyte-current-buffer
- (dolist (header nnslashdot-headers)
- (nnheader-insert-nov (cdr header)))))
+ (dolist (header nnslashdot-headers)
+ (nnheader-insert-nov (cdr header)))))
'nov))
(deffoo nnslashdot-sane-retrieve-headers (articles group)
t)
(goto-char point)
(while (re-search-forward
- "<a name=\"\\([0-9]+\\)\"><\\(b\\|H4\\)>\\([^<]+\\)</\\(b\\|H4\\)>.*score:\\([^)]+\\))"
+ "<a name=\"\\([0-9]+\\)\"><\\(b\\|H4\\)>\\([^<]+\\)</\\(b\\|H4\\)>.*score:\\([^)]+\\))"
nil t)
(setq article (string-to-number (match-string 1))
subject (match-string 3)
"Where nnwarchive will save its files.")
(defvoo nnwarchive-type nil
- "The type of nnwarchive.")
+ "The type of nnwarchive.")
(defvoo nnwarchive-address ""
"The address of nnwarchive.")
(set-buffer nntp-server-buffer)
(erase-buffer)
(let (header)
- (dolist (art articles)
- (if (setq header (assq art nnwarchive-headers))
- (nnheader-insert-nov (cdr header))))))
+ (dolist (art articles)
+ (if (setq header (assq art nnwarchive-headers))
+ (nnheader-insert-nov (cdr header))))))
(let ((elem (assoc group nnwarchive-headers-cache)))
(if elem
(setcdr elem nnwarchive-headers)
(setq nnwarchive-login
(or nnwarchive-login
(read-string
- (format "Login at %s: " server)
- user-mail-address)))
+ (format "Login at %s: " server)
+ user-mail-address)))
(setq nnwarchive-passwd
(or nnwarchive-passwd
(mail-source-read-passwd
(set-buffer nnweb-buffer)
(erase-buffer)
(when (funcall (nnweb-definition 'search) nnweb-search)
- (let ((more t))
- (while more
- (setq nnweb-articles
- (nconc nnweb-articles (nnweb-google-parse-1)))
- ;; FIXME: There is more.
- (setq more nil))
- ;; Return the articles in the right order.
+ (let ((more t))
+ (while more
(setq nnweb-articles
- (sort nnweb-articles 'car-less-than-car))))))
+ (nconc nnweb-articles (nnweb-google-parse-1)))
+ ;; FIXME: There is more.
+ (setq more nil))
+ ;; Return the articles in the right order.
+ (setq nnweb-articles
+ (sort nnweb-articles 'car-less-than-car))))))
(defun nnweb-google-search (search)
(nnweb-insert
(goto-char (point-min))
(while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
(let ((elem (if (eq (aref (match-string 1) 0) ?\#)
- (let ((c
- (string-to-number (substring
- (match-string 1) 1))))
- (if (mm-char-or-char-int-p c) c 32))
- (or (cdr (assq (intern (match-string 1))
- w3-html-entities))
- ?#))))
+ (let ((c
+ (string-to-number (substring
+ (match-string 1) 1))))
+ (if (mm-char-or-char-int-p c) c 32))
+ (or (cdr (assq (intern (match-string 1))
+ w3-html-entities))
+ ?#))))
(unless (stringp elem)
(setq elem (char-to-string elem)))
(replace-match elem t t))))
(push (list from time bstuff) contents))))
(setq contents (nreverse contents))
(dolist (art (cdr elem))
- (push (list (car art)
- (nth (1- (cdr art)) contents)
- subject)
- nnwfm-articles))))
+ (push (list (car art)
+ (nth (1- (cdr art)) contents)
+ subject)
+ nnwfm-articles))))
(setq nnwfm-articles
(sort nnwfm-articles 'car-less-than-car))
;; Now we have all the articles, conveniently in an alist
(unless nnwfm-groups-alist
(nnwfm-read-groups)
(setq nnwfm-groups (cdr (assoc nnwfm-address
- nnwfm-groups-alist)))))
+ nnwfm-groups-alist)))))
(deffoo nnwfm-open-server (server &optional defs connectionless)
(nnheader-init-server-buffer)
(let* ((ssl-program-name
pop3-ssl-program-name)
(ssl-program-arguments
- `(,@pop3-ssl-program-arguments ,extra-arg
+ `(,@pop3-ssl-program-arguments
+ ,extra-arg
"-connect" ,(format "%s:%d" host service)))
(process (open-ssl-stream name buffer host service)))
(when process
(pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))
(t
(as-binary-process
- (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
- (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))))
+ (or (pop3-open-ssl-stream-1 name buffer host service "-ssl3")
+ (pop3-open-ssl-stream-1 name buffer host service "-ssl2"))))))
(defun pop3-open-tls-stream (name buffer host service)
"Open a TLSv1 connection for a service to a host.
(insert output)))
(defun pop3-send-command (process command)
- (set-buffer (process-buffer process))
- (goto-char (point-max))
-;; (if (= (aref command 0) ?P)
-;; (insert "PASS <omitted>\r\n")
-;; (insert command "\r\n"))
- (setq pop3-read-point (point))
- (goto-char (point-max))
- (process-send-string process (concat command "\r\n"))
- )
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+;; (if (= (aref command 0) ?P)
+;; (insert "PASS <omitted>\r\n")
+;; (insert command "\r\n"))
+ (setq pop3-read-point (point))
+ (goto-char (point-max))
+ (process-send-string process (concat command "\r\n"))
+ )
(defun pop3-read-response (process &optional return)
"Read the response from the server PROCESS.
(if (looking-at "From ")
(replace-match "From=20" nil t)
(if (looking-at "-")
- (replace-match "=2D" nil t))))
+ (replace-match "=2D" nil t))))
(end-of-line)
;; Fold long lines.
(while (> (current-column) 76) ; tab-width must be 1.
(rfc2047-narrow-to-field)
(if (not (rfc2047-encodable-p))
(prog1
- (if (and (eq (mm-body-7-or-8) '8bit)
- (mm-multibyte-p)
- (mm-coding-system-p
- (car message-posting-charset)))
- ;; 8 bit must be decoded.
- ;; Is message-posting-charset a coding system?
- (mm-encode-coding-region
- (point-min) (point-max)
- (car message-posting-charset)))
+ (if (and (eq (mm-body-7-or-8) '8bit)
+ (mm-multibyte-p)
+ (mm-coding-system-p
+ (car message-posting-charset)))
+ ;; 8 bit must be decoded.
+ ;; Is message-posting-charset a coding system?
+ (mm-encode-coding-region
+ (point-min) (point-max)
+ (car message-posting-charset)))
;; No encoding necessary, but folding is nice
(rfc2047-fold-region (save-excursion
(goto-char (point-min))
(goto-char (or break qword-break))
(setq break nil
qword-break nil)
- (if (looking-at "[ \t]")
- (insert "\n")
- (insert "\n "))
+ (if (looking-at "[ \t]")
+ (insert "\n")
+ (insert "\n "))
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(skip-chars-forward " \t")
(overlay-put overlay
'help-echo "mouse-2: toggle smilies in buffer")
(overlay-put overlay 'keymap smiley-mouse-map))))))
- (setq smiley-active t)))
+ (setq smiley-active t)))
(defun smiley-toggle-buffer (&optional arg)
"Toggle displaying smiley faces.
(certrr (with-current-buffer digbuf
(dig-extract-rr (smime-mail-to-domain mail) "cert")))
(cert (and certrr (dig-rr-get-pkix-cert certrr))))
- (if cert
- (with-current-buffer retbuf
- (insert "-----BEGIN CERTIFICATE-----\n")
- (let ((i 0) (len (length cert)))
- (while (> (- len 64) i)
- (insert (substring cert i (+ i 64)) "\n")
- (setq i (+ i 64)))
- (insert (substring cert i len) "\n"))
- (insert "-----END CERTIFICATE-----\n"))
- (kill-buffer retbuf)
- (setq retbuf nil))
- (kill-buffer digbuf)
- retbuf))
+ (if cert
+ (with-current-buffer retbuf
+ (insert "-----BEGIN CERTIFICATE-----\n")
+ (let ((i 0) (len (length cert)))
+ (while (> (- len 64) i)
+ (insert (substring cert i (+ i 64)) "\n")
+ (setq i (+ i 64)))
+ (insert (substring cert i len) "\n"))
+ (insert "-----END CERTIFICATE-----\n"))
+ (kill-buffer retbuf)
+ (setq retbuf nil))
+ (kill-buffer digbuf)
+ retbuf))
;; User interface.
(while (not (eobp))
(if (= 0 (following-char))
(delete-char 1)
- (error "Unable to convert from Unicode"))
+ (error "Unable to convert from Unicode"))
(forward-char)))
(defun utf7-encode (string &optional for-imap)
(match-string 1)))))
(setq tempfile (if file-name
(expand-file-name file-name)
- (if (fboundp 'make-temp-file)
- (let ((temporary-file-directory
- uudecode-temporary-file-directory))
- (make-temp-file "uu"))
- (expand-file-name
- (make-temp-name "uu")
- uudecode-temporary-file-directory))))
+ (if (fboundp 'make-temp-file)
+ (let ((temporary-file-directory
+ uudecode-temporary-file-directory))
+ (make-temp-file "uu"))
+ (expand-file-name
+ (make-temp-name "uu")
+ uudecode-temporary-file-directory))))
(let ((cdir default-directory)
default-process-coding-system)
(unwind-protect
(unless (equal total "0")
(goto-char (point-min))
(if (re-search-forward
- "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
+ "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
(setq site (match-string 1))
(webmail-error "list@1"))
(goto-char (point-min))
"type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
nil t)
(setq url (concat url "&" (match-string 1) "="
- (match-string 2))))
+ (match-string 2))))
(delete-region (point-min) (point-max))
(save-excursion
(set-buffer (generate-new-buffer " *webmail-att*"))
projects / elisp / gnus.git- / commitdiff