Mercurial > hg > xemacs-beta

comparison lisp/gnus/message.el @ 118:7d55a9ba150c r20-1b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 9f59509498e1
children cca96a509cfe
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
926 "The same as `mail-fetch-field', only remove all newlines." 926 "The same as `mail-fetch-field', only remove all newlines."
927 (let ((value (mail-fetch-field header nil (not not-all)))) 927 (let ((value (mail-fetch-field header nil (not not-all))))
928 (when value 928 (when value
929 (nnheader-replace-chars-in-string value ?\n ? )))) 929 (nnheader-replace-chars-in-string value ?\n ? ))))
930 930
931 (defun message-add-header (&rest headers)
932 "Add the HEADERS to the message header, skipping those already present."
933 (while headers
934 (let (hclean)
935 (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
936 (error "Invalid header `%s'" (car headers)))
937 (setq hclean (match-string 1 (car headers)))
938 (save-restriction
939 (message-narrow-to-headers)
940 (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
941 (insert (car headers) ?\n))))
942 (setq headers (cdr headers))))
943
931 (defun message-fetch-reply-field (header) 944 (defun message-fetch-reply-field (header)
932 "Fetch FIELD from the message we're replying to." 945 "Fetch FIELD from the message we're replying to."
933 (when (and message-reply-buffer 946 (when (and message-reply-buffer
934 (buffer-name message-reply-buffer)) 947 (buffer-name message-reply-buffer))
935 (save-excursion 948 (save-excursion
946 (buffer-disable-undo (current-buffer)))) 959 (buffer-disable-undo (current-buffer))))
947 960
948 (defun message-functionp (form) 961 (defun message-functionp (form)
949 "Return non-nil if FORM is funcallable." 962 "Return non-nil if FORM is funcallable."
950 (or (and (symbolp form) (fboundp form)) 963 (or (and (symbolp form) (fboundp form))
951 (and (listp form) (eq (car form) 'lambda)))) 964 (and (listp form) (eq (car form) 'lambda))
965 (compiled-function-p form)))
952 966
953 (defun message-strip-subject-re (subject) 967 (defun message-strip-subject-re (subject)
954 "Remove \"Re:\" from subject lines." 968 "Remove \"Re:\" from subject lines."
955 (if (string-match "^[Rr][Ee]: *" subject) 969 (if (string-match "^[Rr][Ee]: *" subject)
956 (substring subject (match-end 0)) 970 (substring subject (match-end 0))
1314 1328
1315 1329
1316 (defun message-insert-to () 1330 (defun message-insert-to ()
1317 "Insert a To header that points to the author of the article being replied to." 1331 "Insert a To header that points to the author of the article being replied to."
1318 (interactive) 1332 (interactive)
1319 (let ((co (message-fetch-field "courtesy-copies-to"))) 1333 (let ((co (message-fetch-field "mail-copies-to")))
1320 (when (and co 1334 (when (and co
1321 (equal (downcase co) "never")) 1335 (equal (downcase co) "never"))
1322 (error "The user has requested not to have copies sent via mail"))) 1336 (error "The user has requested not to have copies sent via mail")))
1323 (when (and (message-position-on-field "To") 1337 (when (and (message-position-on-field "To")
1324 (mail-fetch-field "to") 1338 (mail-fetch-field "to")
3003 (let (ccalist) 3017 (let (ccalist)
3004 (save-excursion 3018 (save-excursion
3005 (message-set-work-buffer) 3019 (message-set-work-buffer)
3006 (unless never-mct 3020 (unless never-mct
3007 (insert (or reply-to from ""))) 3021 (insert (or reply-to from "")))
3008 (insert (if (bolp) "" ", ") (or to "")) 3022 (insert (if to (concat (if (bolp) "" ", ") to "") ""))
3009 (insert (if mct (concat (if (bolp) "" ", ") mct) "")) 3023 (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
3010 (insert (if cc (concat (if (bolp) "" ", ") cc) "")) 3024 (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
3011 (goto-char (point-min)) 3025 (goto-char (point-min))
3012 (while (re-search-forward "[ \t]+" nil t) 3026 (while (re-search-forward "[ \t]+" nil t)
3013 (replace-match " " t t)) 3027 (replace-match " " t t))
3376 (or (and boundary 3390 (or (and boundary
3377 (re-search-forward boundary nil t) 3391 (re-search-forward boundary nil t)
3378 (forward-line 2)) 3392 (forward-line 2))
3379 (and (re-search-forward message-unsent-separator nil t) 3393 (and (re-search-forward message-unsent-separator nil t)
3380 (forward-line 1)) 3394 (forward-line 1))
3381 (and (search-forward "\n\n" nil t) 3395 (re-search-forward "^Return-Path:.*\n" nil t))
3382 (re-search-forward "^Return-Path:.*\n" nil t)))
3383 ;; We remove everything before the bounced mail. 3396 ;; We remove everything before the bounced mail.
3384 (delete-region 3397 (delete-region
3385 (point-min) 3398 (point-min)
3386 (if (re-search-forward "^[^ \n\t]+:" nil t) 3399 (if (re-search-forward "^[^ \n\t]+:" nil t)
3387 (match-beginning 0) 3400 (match-beginning 0)