X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=ab49c59b38135d1ff9740e86748fb99e963968af;hb=4dabda05e0e0b169ba3dede4cde0b7f6fa9bfc9a;hp=164db7f8ebb2ed0d9b0f30f2e49cdfd3c529f053;hpb=b5f139c2535bc2ed0c76280a6e415579aebc0e83;p=gnus diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 164db7f8e..ab49c59b3 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -38,7 +38,6 @@ ;;; Code: (require 'mail-utils) -(require 'sendmail) (eval-when-compile (require 'cl)) (defvar nnheader-max-head-length 4096 @@ -234,7 +233,8 @@ on your system, you could say something like: (or (mail-header-subject header) "(none)") "\t" (or (mail-header-from header) "(nobody)") "\t" (or (mail-header-date header) "") "\t" - (or (mail-header-id header) "") "\t" + (or (mail-header-id header) + (nnmail-message-id)) "\t" (or (mail-header-references header) "") "\t") (princ (or (mail-header-chars header) 0) (current-buffer)) (insert "\t") @@ -297,7 +297,7 @@ on your system, you could say something like: (when (file-exists-p file) (if (eq nnheader-max-head-length t) ;; Just read the entire file. - (insert-file-contents-literally file) + (nnheader-insert-file-contents-literally file) ;; Read 1K blocks until we find a separator. (let ((beg 0) format-alist @@ -390,7 +390,7 @@ on your system, you could say something like: (put 'nnheader-temp-write 'lisp-indent-function 1) (put 'nnheader-temp-write 'lisp-indent-hook 1) -(put 'nnheader-temp-write 'edebug-form-spec '(file &rest form)) +(put 'nnheader-temp-write 'edebug-form-spec '(form body)) (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files @@ -415,15 +415,28 @@ on your system, you could say something like: (string-match nnheader-numerical-short-files file) (string-to-int (match-string 0 file)))) +(defun nnheader-directory-files-safe (&rest args) + ;; It has been reported numerous times that `directory-files' + ;; fails with an alarming frequency on NFS mounted file systems. + ;; This function executes that function twice and returns + ;; the longest result. + (let ((first (apply 'directory-files args)) + (second (apply 'directory-files args))) + (if (> (length first) (length second)) + first + second))) + (defun nnheader-directory-articles (dir) "Return a list of all article files in a directory." (mapcar 'nnheader-file-to-number - (directory-files dir nil nnheader-numerical-short-files t))) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t))) (defun nnheader-article-to-file-alist (dir) "Return an alist of article/file pairs in DIR." (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (directory-files dir nil nnheader-numerical-short-files t))) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t))) (defun nnheader-fold-continuation-lines () "Fold continuation lines in the current buffer." @@ -437,16 +450,22 @@ on your system, you could say something like: file ;; We translate -- but only the file name. We leave the directory ;; alone. - (let* ((new (file-name-nondirectory file)) - (len (length new)) - (i 0) - trans) + (let* ((i 0) + trans leaf path len) + (if (string-match "/[^/]+\\'" file) + ;; This is needed on NT's and stuff. + (setq leaf (substring file (1+ (match-beginning 0))) + path (substring file 0 (1+ (match-beginning 0)))) + ;; Fall back on this. + (setq leaf (file-name-nondirectory file) + path (file-name-directory file))) + (setq len (length leaf)) (while (< i len) - (when (setq trans (cdr (assq (aref new i) + (when (setq trans (cdr (assq (aref leaf i) nnheader-file-name-translation-alist))) - (aset new i trans)) + (aset leaf i trans)) (incf i)) - (concat (file-name-directory file) new)))) + (concat path leaf)))) (defun nnheader-report (backend &rest args) "Report an error from the BACKEND. @@ -479,7 +498,7 @@ without formatting." (file-regular-p file)) (save-excursion (nnheader-set-temp-buffer " *mail-file-mbox-p*") - (insert-file-contents-literally file) + (nnheader-insert-file-contents-literally file) (goto-char (point-min)) (prog1 (looking-at message-unix-mail-delimiter) @@ -540,11 +559,62 @@ without formatting." (or (and (symbolp form) (fboundp form)) (and (listp form) (eq (car form) 'lambda)))) +(defun nnheader-concat (dir file) + "Concat DIR as directory to FILE." + (concat (file-name-as-directory dir) file)) + +(defun nnheader-ms-strip-cr () + "Strip ^M from the end of all lines." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (delete-backward-char 1)))) + +(defun nnheader-file-size (file) + "Return the file size of FILE or 0." + (or (nth 7 (file-attributes file)) 0)) + +(defun nnheader-find-etc-directory (package) + "Go through the path and find the \".../etc/PACKAGE\" directory." + (let ((path load-path) + dir result) + ;; We try to find the dir by looking at the load path, + ;; stripping away the last component and adding "etc/". + (while path + (if (and (car path) + (file-exists-p + (setq dir (concat + (file-name-directory + (directory-file-name (car path))) + "etc/" package "/"))) + (file-directory-p dir)) + (setq result dir + path nil) + (setq path (cdr path)))) + result)) + +(defvar ange-ftp-path-format) +(defvar efs-path-regexp) +(defun nnheader-re-read-dir (path) + "Re-read directory PATH if PATH is on a remote system." + (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) + (when (string-match efs-path-regexp path) + (efs-re-read-dir path)) + (if (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) + (when (string-match (car ange-ftp-path-format) path) + (ange-ftp-re-read-dir path))))) + +(fset 'nnheader-run-at-time 'run-at-time) +(fset 'nnheader-cancel-timer 'cancel-timer) (fset 'nnheader-find-file-noselect 'find-file-noselect) -(fset 'nnheader-insert-raw-file-contents 'insert-file-contents) +(fset 'nnheader-insert-file-contents-literally + 'insert-file-contents-literally) -(provide 'nnheader) +(when (string-match "XEmacs\\|Lucid" emacs-version) + (require 'nnheaderxm)) (run-hooks 'nnheader-load-hook) +(provide 'nnheader) + ;;; nnheader.el ends here