/[emacs]/emacs/lisp/gnus/nneething.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nneething.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5.2.1 by miles, Tue Oct 14 23:34:51 2003 UTC revision 1.5.2.2 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
1  ;;; nneething.el --- arbitrary file access for Gnus  ;;; nneething.el --- arbitrary file access for Gnus
2    
3  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
4  ;;      Free Software Foundation, Inc.  ;;      Free Software Foundation, Inc.
5    
6  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7  ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>  ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8  ;; Keywords: news, mail  ;; Keywords: news, mail
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 64  included.") Line 64  included.")
64    
65  (defvoo nneething-status-string "")  (defvoo nneething-status-string "")
66    
 (defvoo nneething-message-id-number 0)  
67  (defvoo nneething-work-buffer " *nneething work*")  (defvoo nneething-work-buffer " *nneething work*")
68    
69  (defvoo nneething-group nil)  (defvoo nneething-group nil)
# Line 122  included.") Line 121  included.")
121    (let ((file (unless (stringp id)    (let ((file (unless (stringp id)
122                  (nneething-file-name id)))                  (nneething-file-name id)))
123          (nntp-server-buffer (or buffer nntp-server-buffer)))          (nntp-server-buffer (or buffer nntp-server-buffer)))
124      (and (stringp file)                 ; We did not request by Message-ID.      (and (stringp file)            ; We did not request by Message-ID.
125           (file-exists-p file)           ; The file exists.           (file-exists-p file)           ; The file exists.
126           (not (file-directory-p file))  ; It's not a dir.           (not (file-directory-p file))  ; It's not a dir.
127           (save-excursion           (save-excursion
128             (nnmail-find-file file)      ; Insert the file in the nntp buf.             (let ((nnmail-file-coding-system 'binary))
129                 (nnmail-find-file file))   ; Insert the file in the nntp buf.
130             (unless (nnheader-article-p) ; Either it's a real article...             (unless (nnheader-article-p) ; Either it's a real article...
131               (goto-char (point-min))               (let ((type
132               (nneething-make-head                      (unless (file-directory-p file)
133                file (current-buffer))    ; ... or we fake some headers.                        (or (cdr (assoc (concat "." (file-name-extension file))
134                                          mailcap-mime-extensions))
135                              "text/plain")))
136                       (charset
137                        (mm-detect-mime-charset-region (point-min) (point-max)))
138                       (encoding))
139                   (unless (string-match "\\`text/" type)
140                     (base64-encode-region (point-min) (point-max))
141                     (setq encoding "base64"))
142                   (goto-char (point-min))
143                   (nneething-make-head file (current-buffer)
144                                        nil type charset encoding))
145               (insert "\n"))               (insert "\n"))
146             t))))             t))))
147    
# Line 234  included.") Line 245  included.")
245              prev)              prev)
246          (while map          (while map
247            (if (and (member (cadr (car map)) files)            (if (and (member (cadr (car map)) files)
248                     ;; We also remove files that have changed mod times.                    ;; We also remove files that have changed mod times.
249                     (equal (nth 5 (file-attributes                     (equal (nth 5 (file-attributes
250                                    (nneething-file-name (cadr (car map)))))                                    (nneething-file-name (cadr (car map)))))
251                            (cadr (cdar map))))                            (cadr (cdar map))))
# Line 272  included.") Line 283  included.")
283      (insert-buffer-substring nneething-work-buffer)      (insert-buffer-substring nneething-work-buffer)
284      (goto-char (point-max))))      (goto-char (point-max))))
285    
286  (defun nneething-make-head (file &optional buffer)  (defun nneething-encode-file-name (file &optional coding-system)
287      "Encode the name of the FILE in CODING-SYSTEM."
288      (let ((pos 0) buf)
289        (setq file (mm-encode-coding-string
290                    file (or coding-system nnmail-pathname-coding-system)))
291        (while (string-match "[^-0-9a-zA-Z_:/.]" file pos)
292          (setq buf (cons (format "%%%02x" (aref file (match-beginning 0)))
293                          (cons (substring file pos (match-beginning 0)) buf))
294                pos (match-end 0)))
295        (apply (function concat)
296               (nreverse (cons (substring file pos) buf)))))
297    
298    (defun nneething-decode-file-name (file &optional coding-system)
299      "Decode the name of the FILE is encoded in CODING-SYSTEM."
300      (let ((pos 0) buf)
301        (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos)
302          (setq buf (cons (string (string-to-number (match-string 1 file) 16))
303                          (cons (substring file pos (match-beginning 0)) buf))
304                pos (match-end 0)))
305        (decode-coding-string
306         (apply (function concat)
307                (nreverse (cons (substring file pos) buf)))
308         (or coding-system nnmail-pathname-coding-system))))
309    
310    (defun nneething-get-file-name (id)
311      "Extract the file name from the message ID string."
312      (when (string-match "\\`<nneething-\\([^@]+\\)@.*>\\'" id)
313        (nneething-decode-file-name (match-string 1 id))))
314    
315    (defun nneething-make-head (file &optional buffer extra-msg
316                                     mime-type mime-charset mime-encoding)
317    "Create a head by looking at the file attributes of FILE."    "Create a head by looking at the file attributes of FILE."
318    (let ((atts (file-attributes file)))    (let ((atts (file-attributes file)))
319      (insert      (insert
320       "Subject: " (file-name-nondirectory file) "\n"       "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n"
321       "Message-ID: <nneething-"       "Message-ID: <nneething-" (nneething-encode-file-name file)
      (int-to-string (incf nneething-message-id-number))  
322       "@" (system-name) ">\n"       "@" (system-name) ">\n"
323       (if (equal '(0 0) (nth 5 atts)) ""       (if (equal '(0 0) (nth 5 atts)) ""
324         (concat "Date: " (current-time-string (nth 5 atts)) "\n"))         (concat "Date: " (current-time-string (nth 5 atts)) "\n"))
# Line 297  included.") Line 337  included.")
337             (concat "Lines: " (int-to-string             (concat "Lines: " (int-to-string
338                                (count-lines (point-min) (point-max)))                                (count-lines (point-min) (point-max)))
339                     "\n"))                     "\n"))
340           "")
341         (if mime-type
342             (concat "Content-Type: " mime-type
343                     (if mime-charset
344                         (concat "; charset="
345                                 (if (stringp mime-charset)
346                                     mime-charset
347                                   (symbol-name mime-charset)))
348                       "")
349                     (if mime-encoding
350                         (concat "\nContent-Transfer-Encoding: " mime-encoding)
351                       "")
352                     "\nMIME-Version: 1.0\n")
353         ""))))         ""))))
354    
355  (defun nneething-from-line (uid &optional file)  (defun nneething-from-line (uid &optional file)
# Line 344  included.") Line 397  included.")
397        (nneething-make-head file) t)        (nneething-make-head file) t)
398       (t       (t
399        ;; We examine the file.        ;; We examine the file.
400        (nnheader-insert-head file)        (condition-case ()
401        (if (nnheader-article-p)            (progn
402            (delete-region              (nnheader-insert-head file)
403             (progn              (if (nnheader-article-p)
404               (goto-char (point-min))                  (delete-region
405               (or (and (search-forward "\n\n" nil t)                   (progn
406                        (1- (point)))                     (goto-char (point-min))
407                   (point-max)))                     (or (and (search-forward "\n\n" nil t)
408             (point-max))                              (1- (point)))
409          (goto-char (point-min))                         (point-max)))
410          (nneething-make-head file (current-buffer))                   (point-max))
411          (delete-region (point) (point-max)))                (goto-char (point-min))
412                  (nneething-make-head file (current-buffer))
413                  (delete-region (point) (point-max))))
414            (file-error
415             (nneething-make-head file (current-buffer) " (unreadable)")))
416        t))))        t))))
417    
418  (defun nneething-file-name (article)  (defun nneething-file-name (article)
419    "Return the file name of ARTICLE."    "Return the file name of ARTICLE."
420    (let ((dir (file-name-as-directory nneething-address))    (let ((dir (file-name-as-directory nneething-address))
421          fname)          fname)
422      (if (numberp article)      (if (numberp article)
423          (if (setq fname (cadr (assq article nneething-map)))          (if (setq fname (cadr (assq article nneething-map)))
424              (expand-file-name fname dir)              (expand-file-name fname dir)

Legend:
Removed from v.1.5.2.1  
changed lines
  Added in v.1.5.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26