From: yamaoka Date: Thu, 10 Dec 1998 08:18:35 +0000 (+0000) Subject: * lisp/pop3.el (pop3-movemail): Use `write-region-as-binary' instead of X-Git-Tag: pgnus-ichikawa-199812101900~3 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=76e041618e229e8f33dc4470a6ae808e850b089e;p=elisp%2Fgnus.git- * lisp/pop3.el (pop3-movemail): Use `write-region-as-binary' instead of `append-to-file'. (pop3-movemail-file-coding-system): Abolished. * lisp/nnheader.el (nnheader-find-file-noselect): Use `find-file-noselect-as-specified-coding-system' instead of `find-file-noselect'. * lisp/gnus-score.el (gnus-score-load-score-alist): Use `insert-file-contents-as-specified-coding-system' instead of `insert-file-contents'. * lisp/nnmail.el (nnmail-find-file): Ditto. * lisp/nnheader.el (nnheader-insert-file-contents): Ditto. * lisp/message.el (message-send-mail-with-qmail): Enclose `call-process-region' with `as-binary-process'. (message-send-mail-with-sendmail): Ditto. (message-send-coding-system): Abolished. * lisp/score-mode.el (gnus-score-edit-exit): Emulate `save-buffer' with `write-region-as-specified-coding-system'. * lisp/gnus-start.el (gnus-save-newsrc-file): Ditto. * lisp/gnus-start.el (gnus-read-newsrc-el-file): Emulate `load' with `insert-file-contents-as-specified-coding-system' and `eval-region'. * lisp/gnus-score.el (gnus-score-save): Use `gnus-write-buffer-as-specified-coding-system' instead of `gnus-write-buffer'. * lisp/gnus-cache.el (gnus-cache-possibly-enter-article): Ditto. (gnus-cache-save-buffers): Ditto. * lisp/gnus-util.el (gnus-output-to-mail): Use `write-region-as-binary' instead of `append-to-file'. (gnus-output-to-mail): Use `gnus-write-buffer-as-binary' instead of `gnus-write-buffer'. (gnus-write-buffer-as-specified-coding-system): New function. (gnus-write-buffer-as-binary): New function. * lisp/nnmail.el (nnmail-write-region): Use `write-region-as-specified-coding-system' instead of `write-region'. * lisp/gnus-agent.el (gnus-agent-expire): Ditto. (gnus-agent-fetch-headers): Ditto. (gnus-agent-flush-cache): Ditto. (gnus-agent-fetch-articles): Ditto. (gnus-agent-save-history): Ditto. (gnus-agent-save-groups): Ditto. (gnus-agent-save-active): Ditto. --- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index fd213ef..e95246b 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -526,8 +526,9 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "active"))) (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) + (write-region-as-specified-coding-system + (point-min) (point-max) file nil 'silent + gnus-agent-file-coding-system) (when (file-exists-p (gnus-agent-lib-file "groups")) (delete-file (gnus-agent-lib-file "groups")))))) @@ -535,8 +536,9 @@ the actual number of articles toggled is returned." (let* ((gnus-command-method method) (file (gnus-agent-lib-file "groups"))) (gnus-make-directory (file-name-directory file)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) + (write-region-as-specified-coding-system + (point-min) (point-max) file nil 'silent + gnus-agent-file-coding-system) (when (file-exists-p (gnus-agent-lib-file "active")) (delete-file (gnus-agent-lib-file "active"))))) @@ -608,9 +610,9 @@ the actual number of articles toggled is returned." (save-excursion (set-buffer gnus-agent-current-history) (gnus-make-directory (file-name-directory gnus-agent-file-name)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (1+ (point-min)) (point-max) - gnus-agent-file-name nil 'silent)))) + (write-region-as-specified-coding-system + (1+ (point-min)) (point-max) gnus-agent-file-name nil 'silent + gnus-agent-file-coding-system))) (defun gnus-agent-close-history () (when (gnus-buffer-live-p gnus-agent-current-history) @@ -707,11 +709,10 @@ the actual number of articles toggled is returned." (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) (setq id "No-Message-ID-in-article") (setq id (buffer-substring (match-beginning 1) (match-end 1)))) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) - (concat dir (number-to-string (caar pos))) - nil 'silent)) + (write-region-as-specified-coding-system + (point-min) (point-max) + (concat dir (number-to-string (caar pos))) nil 'silent + gnus-agent-file-coding-system) (when (setq elem (assq (caar pos) gnus-agent-article-alist)) (setcdr elem t)) (gnus-agent-enter-history @@ -751,12 +752,11 @@ the actual number of articles toggled is returned." (save-excursion (while gnus-agent-buffer-alist (set-buffer (cdar gnus-agent-buffer-alist)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) - (gnus-agent-article-name ".overview" - (caar gnus-agent-buffer-alist)) - nil 'silent)) + (write-region-as-specified-coding-system + (point-min) (point-max) + (gnus-agent-article-name ".overview" + (caar gnus-agent-buffer-alist)) + nil 'silent gnus-agent-file-coding-system) (pop gnus-agent-buffer-alist)) (while gnus-agent-group-alist (with-temp-file (caar gnus-agent-group-alist) @@ -787,9 +787,9 @@ the actual number of articles toggled is returned." (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) (when (file-exists-p file) (gnus-agent-braid-nov group articles file)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) + (write-region-as-specified-coding-system + (point-min) (point-max) file nil 'silent + gnus-agent-file-coding-system) (gnus-agent-save-alist group articles nil) (gnus-agent-enter-history "last-header-fetched-for-session" @@ -1401,9 +1401,9 @@ The following commands are available: ;; Schedule the history line for nuking. (push (cdr elem) histories))) (gnus-make-directory (file-name-directory nov-file)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) nov-file nil 'silent)) + (write-region-as-specified-coding-system + (point-min) (point-max) nov-file nil 'silent + gnus-agent-file-coding-system) ;; Delete the unwanted entries in the alist. (setq gnus-agent-article-alist (sort gnus-agent-article-alist 'car-less-than-car)) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index c621a6e..3059362 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -129,9 +129,8 @@ it's not cached." (set-buffer buffer) (if (> (buffer-size) 0) ;; Non-empty overview, write it to a file. - (let ((coding-system-for-write - gnus-cache-overview-coding-system)) - (gnus-write-buffer overview-file)) + (gnus-write-buffer-as-specified-coding-system + overview-file gnus-cache-overview-coding-system) ;; Empty overview file, remove it (when (file-exists-p overview-file) (delete-file overview-file)) @@ -184,9 +183,8 @@ it's not cached." (gnus-article-decode-hook nil)) (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) - (let ((coding-system-for-write - gnus-cache-write-file-coding-system)) - (gnus-write-buffer file)) + (gnus-write-buffer-as-specified-coding-system + file gnus-cache-write-file-coding-system) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-max)) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index bd20597..4d54a3d 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1236,8 +1236,8 @@ EXTRA is the possible non-standard header." (setq gnus-score-alist nil) ;; Read file. (with-temp-buffer - (let ((coding-system-for-write score-mode-coding-system)) - (insert-file-contents file)) + (insert-file-contents-as-specified-coding-system + file score-mode-coding-system) (goto-char (point-min)) ;; Only do the loading if the score file isn't empty. (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) @@ -1370,8 +1370,8 @@ EXTRA is the possible non-standard header." (delete-file file) ;; There are scores, so we write the file. (when (file-writable-p file) - (let ((coding-system-for-write score-mode-coding-system)) - (gnus-write-buffer file)) + (gnus-write-buffer-as-specified-coding-system + file score-mode-coding-system) (when gnus-score-after-write-file-function (funcall gnus-score-after-write-file-function file))))) (and gnus-score-uncacheable-files diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 453a02b..a5d426d 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1922,8 +1922,10 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Reading %s..." ding-file) (let (gnus-newsrc-assoc) (condition-case nil - (let ((coding-system-for-read gnus-startup-file-coding-system)) - (load ding-file t t t)) + (with-temp-buffer + (insert-file-contents-as-specified-coding-system + ding-file gnus-startup-file-coding-system) + (eval-region (point-min) (point-max))) (error (ding) (unless (gnus-yes-or-no-p @@ -2284,8 +2286,10 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (let ((coding-system-for-write gnus-startup-file-coding-system)) - (save-buffer)) + (write-region-as-specified-coding-system + (point-min) (point-max) (buffer-file-name) + gnus-startup-file-coding-system) + (set-buffer-modified-p nil) (kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 6567bcd..4b63fec 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -553,6 +553,21 @@ Bind `print-quoted' and `print-readably' to t while printing." ;; Write the buffer. (write-region (point-min) (point-max) file nil 'quietly)) +(defun gnus-write-buffer-as-binary (file) + "Write the current buffer's contents to FILE without code conversion." + ;; Make sure the directory exists. + (gnus-make-directory (file-name-directory file)) + ;; Write the buffer. + (write-region-as-binary (point-min) (point-max) file nil 'quietly)) + +(defun gnus-write-buffer-as-specified-coding-system (file coding-system) + "Write the current buffer's contents to FILE with code conversion." + ;; Make sure the directory exists. + (gnus-make-directory (file-name-directory file)) + ;; Write the buffer. + (write-region-as-specified-coding-system + (point-min) (point-max) file nil 'quietly coding-system)) + (defun gnus-delete-file (file) "Delete FILE if it exists." (when (file-exists-p file) @@ -734,9 +749,8 @@ with potentially long computations." (let ((file-buffer (create-file-buffer filename))) (save-excursion (set-buffer file-buffer) - (let ((require-final-newline nil) - (coding-system-for-write 'binary)) - (gnus-write-buffer filename))) + (let ((require-final-newline nil)) + (gnus-write-buffer-as-binary filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (set-buffer tmpbuf) @@ -753,8 +767,7 @@ with potentially long computations." ;; Decide whether to append to a file or to an Emacs buffer. (let ((outbuf (get-file-buffer filename))) (if (not outbuf) - (let ((buffer-read-only nil) - (coding-system-for-write 'binary)) + (let ((buffer-read-only nil)) (save-excursion (goto-char (point-max)) (forward-char -2) @@ -764,7 +777,8 @@ with potentially long computations." (insert "\n")) (insert "\n")) (goto-char (point-max)) - (append-to-file (point-min) (point-max) filename))) + (write-region-as-binary (point-min) (point-max) + filename 'append))) ;; File has been visited, in buffer OUTBUF. (set-buffer outbuf) (let ((buffer-read-only nil)) diff --git a/lisp/message.el b/lisp/message.el index f45b24c..aeae6b8 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1033,9 +1033,6 @@ The cdr of ech entry is a function for applying the face to a region.") (const :tag "always" t) (const :tag "ask" ask))) -(defvar message-send-coding-system 'binary - "Coding system to encode outgoing mail.") - (defvar message-draft-coding-system (cond ((not (fboundp 'coding-system-p)) nil) @@ -2471,31 +2468,31 @@ This sub function is for exclusive use of `message-send-mail'." (save-excursion (set-buffer errbuf) (erase-buffer)))) - (let ((default-directory "/") - (coding-system-for-write message-send-coding-system)) - (apply 'call-process-region - (append (list (point-min) (point-max) - (if (boundp 'sendmail-program) - sendmail-program - "/usr/lib/sendmail") - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - ;; But some systems are more broken with -f, so - ;; we'll let users override this. - (if (null message-sendmail-f-is-evil) - (list "-f" (user-login-name))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t"))))) + (let ((default-directory "/")) + (as-binary-process + (apply 'call-process-region + (append (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + ;; Always specify who from, + ;; since some systems have broken sendmails. + ;; But some systems are more broken with -f, so + ;; we'll let users override this. + (if (null message-sendmail-f-is-evil) + (list "-f" (user-login-name))) + ;; These mean "report errors by mail" + ;; and "deliver in background". + (if (null message-interactive) '("-oem" "-odb")) + ;; Get the addresses from the message + ;; unless this is a resend. + ;; We must not do that for a resend + ;; because we would find the original addresses. + ;; For a resend, include the specific addresses. + (if resend-to-addresses + (list resend-to-addresses) + '("-t")))))) (when message-interactive (save-excursion (set-buffer errbuf) @@ -2521,28 +2518,28 @@ to find out how to use this." (run-hooks 'message-send-mail-hook) ;; send the message (case - (let ((coding-system-for-write message-send-coding-system)) - (apply - 'call-process-region 1 (point-max) message-qmail-inject-program - nil nil nil - ;; qmail-inject's default behaviour is to look for addresses on the - ;; command line; if there're none, it scans the headers. - ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. - ;; - ;; in general, ALL of qmail-inject's defaults are perfect for simply - ;; reading a formatted (i. e., at least a To: or Resent-To header) - ;; message from stdin. - ;; - ;; qmail also has the advantage of not having been raped by - ;; various vendors, so we don't have to allow for that, either -- - ;; compare this with message-send-mail-with-sendmail and weep - ;; for sendmail's lost innocence. - ;; - ;; all this is way cool coz it lets us keep the arguments entirely - ;; free for -inject-arguments -- a big win for the user and for us - ;; since we don't have to play that double-guessing game and the user - ;; gets full control (no gestapo'ish -f's, for instance). --sj - message-qmail-inject-args)) + (as-binary-process + (apply + 'call-process-region 1 (point-max) message-qmail-inject-program + nil nil nil + ;; qmail-inject's default behaviour is to look for addresses on the + ;; command line; if there're none, it scans the headers. + ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. + ;; + ;; in general, ALL of qmail-inject's defaults are perfect for simply + ;; reading a formatted (i. e., at least a To: or Resent-To header) + ;; message from stdin. + ;; + ;; qmail also has the advantage of not having been raped by + ;; various vendors, so we don't have to allow for that, either -- + ;; compare this with message-send-mail-with-sendmail and weep + ;; for sendmail's lost innocence. + ;; + ;; all this is way cool coz it lets us keep the arguments entirely + ;; free for -inject-arguments -- a big win for the user and for us + ;; since we don't have to play that double-guessing game and the user + ;; gets full control (no gestapo'ish -f's, for instance). --sj + message-qmail-inject-args)) ;; qmail-inject doesn't say anything on it's stdout/stderr, ;; we have to look at the retval instead (0 nil) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 96f84d5..764c48f 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -769,9 +769,9 @@ find-file-hooks, etc. (default-major-mode 'fundamental-mode) (enable-local-variables nil) (after-insert-file-functions nil) - (find-file-hooks nil) - (coding-system-for-read nnheader-file-coding-system)) - (insert-file-contents filename visit beg end replace))) + (find-file-hooks nil)) + (insert-file-contents-as-specified-coding-system + filename visit beg end replace nnheader-file-coding-system))) (defun nnheader-find-file-noselect (&rest args) (let ((format-alist nil) @@ -779,9 +779,9 @@ find-file-hooks, etc. (default-major-mode 'fundamental-mode) (enable-local-variables nil) (after-insert-file-functions nil) - (find-file-hooks nil) - (coding-system-for-read nnheader-file-coding-system)) - (apply 'find-file-noselect args))) + (find-file-hooks nil)) + (apply 'find-file-noselect-as-specified-coding-system + (append args (list nnheader-file-coding-system))))) (defun nnheader-auto-mode-alist () "Return an `auto-mode-alist' with only the .gz (etc) thingies." diff --git a/lisp/nnmail.el b/lisp/nnmail.el index bb0be67..ecafebd 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -508,10 +508,10 @@ parameter. It should return nil, `warn' or `delete'." (let ((format-alist nil) (after-insert-file-functions nil)) (condition-case () - (let ((coding-system-for-read nnmail-file-coding-system) - (auto-mode-alist (nnheader-auto-mode-alist)) + (let ((auto-mode-alist (nnheader-auto-mode-alist)) (pathname-coding-system nnmail-file-coding-system)) - (insert-file-contents file) + (insert-file-contents-as-specified-coding-system + file nnmail-file-coding-system) t) (file-error nil)))) @@ -1679,9 +1679,9 @@ If ARGS, PROMPT is used as an argument to `format'." (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." - (let ((coding-system-for-write nnmail-file-coding-system) - (pathname-coding-system 'binary)) - (write-region start end filename append visit lockname) + (let ((pathname-coding-system 'binary)) + (write-region-as-specified-coding-system + start end filename append visit lockname nnmail-file-coding-system) (set-file-modes filename nnmail-default-file-modes))) ;;; diff --git a/lisp/pop3.el b/lisp/pop3.el index e3f084b..2d1b825 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -60,9 +60,6 @@ values are 'apop.") "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") -(defvar pop3-movemail-file-coding-system 'binary - "Crashbox made by pop3-movemail with this coding system.") - (defvar pop3-read-point nil) (defvar pop3-debug nil) @@ -94,8 +91,7 @@ Used for APOP authentication.") (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) - (let ((coding-system-for-write pop3-movemail-file-coding-system)) - (append-to-file (point-min) (point-max) crashbox)) + (write-region-as-binary (point-min) (point-max) crashbox 'append) (set-buffer (process-buffer process)) (while (> (buffer-size) 5000) (goto-char (point-min)) diff --git a/lisp/score-mode.el b/lisp/score-mode.el index 0fb3cf0..23612ce 100644 --- a/lisp/score-mode.el +++ b/lisp/score-mode.el @@ -100,8 +100,9 @@ This mode is an extended emacs-lisp mode. (interactive) (unless (file-exists-p (file-name-directory (buffer-file-name))) (make-directory (file-name-directory (buffer-file-name)) t)) - (let ((coding-system-for-write score-mode-coding-system)) - (save-buffer)) + (write-region-as-specified-coding-system + (point-min) (point-max) (buffer-file-name) score-mode-coding-system) + (set-buffer-modified-p nil) (bury-buffer (current-buffer)) (let ((buf (current-buffer))) (when gnus-score-edit-exit-function