Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

*** empty log message ***

  • Loading branch information...
commit 29d88dc82d12421f6616ab1dcd11a3035a0875ee 1 parent 4332ff5
Lars Ingebrigtsen authored September 13, 1998
56  lisp/ChangeLog
... ...
@@ -1,3 +1,59 @@
  1
+Sun Sep 13 09:37:37 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
  2
+
  3
+	* gnus.el: Pterodactyl Gnus v0.30 is released.
  4
+
  5
+1998-09-13 08:00:41  Lars Magne Ingebrigtsen  <larsi@gnus.org>
  6
+
  7
+	* gnus-art.el (article-decode-encoded-words): Use it.
  8
+	(gnus-decode-header-function): New variable.
  9
+
  10
+	* gnus-sum.el (gnus-nov-parse-line): Use it.
  11
+	(gnus-decode-encoded-word-function): New variable.
  12
+
  13
+	* gnus-msg.el (gnus-copy-article-buffer): Decode the right
  14
+	buffer. 
  15
+
  16
+	* gnus-art.el (gnus-insert-mime-button): Use widget.
  17
+	(gnus-widget-press-button): New function.
  18
+	(gnus-article-prev-button): Removed.
  19
+	(gnus-article-next-button): Ditto.
  20
+	(gnus-article-add-button): Ditto.
  21
+
  22
+	* gnus.el (gnus-article-mode-map): Inherit from widget.
  23
+	(gnus-article-mode-map): No, don't.
  24
+
  25
+	* mm-decode.el (mm-dissect-buffer): Store Content-ID things.
  26
+	(mm-content-id-alist): New variable.
  27
+	(mm-get-content-id): New function.
  28
+
  29
+	* gnus-art.el (gnus-request-article-this-buffer): Only decode
  30
+	articles if we are fetching to the article buffer.
  31
+
  32
+1998-09-13 07:58:59  Shenghuo ZHU  <zsh@cs.rochester.edu>
  33
+
  34
+	* gnus-sum.el (gnus-summary-move-article): Don't decode accepting
  35
+	articles. 
  36
+
  37
+1998-09-13 07:23:28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
  38
+
  39
+	* mm-util.el (mm-mime-charset): Try to use safe-charsets.
  40
+	(mm-default-mime-charset): New variable.
  41
+
  42
+	* rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. 
  43
+
  44
+	* drums.el (drums-quote-string): Reversed test.
  45
+
  46
+1998-09-12 14:29:21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
  47
+
  48
+	* mm-util.el (mm-insert-rfc822-headers): Possibly not quote
  49
+	string. 
  50
+
  51
+	* drums.el (drums-quote-string): New function.
  52
+
  53
+	* rfc2047.el (rfc2047-encode-message-header): Goto point-min.
  54
+	(rfc2047-b-encode-region): Chop lines.
  55
+	(rfc2047-q-encode-region): Ditto.
  56
+
1 57
 Sat Sep 12 13:27:15 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
2 58
 
3 59
 	* gnus.el: Pterodactyl Gnus v0.29 is released.
6  lisp/drums.el
@@ -231,6 +231,12 @@
231 231
      (point-max)))
232 232
   (goto-char (point-min)))
233 233
 
  234
+(defun drums-quote-string (string)
  235
+  "Quote string if it needs quoting to be displayed in a header."
  236
+  (if (not (string-match (concat "[^" drums-atext-token "]") string))
  237
+      (concat "\"" string "\"")
  238
+    string))
  239
+
234 240
 (provide 'drums)
235 241
 
236 242
 ;;; drums.el ends here
5  lisp/gnus-agent.el
@@ -27,8 +27,9 @@
27 27
 (require 'gnus-cache)
28 28
 (require 'nnvirtual)
29 29
 (require 'gnus-sum)
30  
-(eval-when-compile (require 'cl)
31  
-		   (require 'gnus-score))
  30
+(eval-when-compile
  31
+  (require 'cl)
  32
+  (require 'gnus-score))
32 33
 
33 34
 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
34 35
   "Where the Gnus agent will store its files."
69  lisp/gnus-art.el
@@ -37,6 +37,7 @@
37 37
 (require 'mail-parse)
38 38
 (require 'mm-decode)
39 39
 (require 'mm-view)
  40
+(require 'wid-edit)
40 41
 
41 42
 (defgroup gnus-article nil
42 43
   "Article display."
@@ -542,6 +543,9 @@ displayed by the first non-nil matching CONTENT face."
542 543
   :group 'gnus-article-headers
543 544
   :type 'function)
544 545
 
  546
+(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
  547
+  "Function used to decode headers.")
  548
+
545 549
 ;;; Internal variables
546 550
 
547 551
 (defvar article-lapsed-timer nil)
@@ -990,7 +994,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
990 994
 	(buffer-read-only nil))
991 995
     (save-restriction
992 996
       (message-narrow-to-head)
993  
-      (mail-decode-encoded-word-region (point-min) (point-max)))))
  997
+      (funcall gnus-decode-header-function (point-min) (point-max)))))
994 998
 
995 999
 (defun article-de-quoted-unreadable (&optional force)
996 1000
   "Translate a quoted-printable-encoded article.
@@ -1866,19 +1870,18 @@ If variable `gnus-use-long-file-name' is non-nil, it is
1866 1870
 
1867 1871
 (put 'gnus-article-mode 'mode-class 'special)
1868 1872
 
  1873
+(set-keymap-parent gnus-article-mode-map widget-keymap)
  1874
+
1869 1875
 (gnus-define-keys gnus-article-mode-map
1870 1876
   " " gnus-article-goto-next-page
1871 1877
   "\177" gnus-article-goto-prev-page
1872 1878
   [delete] gnus-article-goto-prev-page
  1879
+  "\r" widget-button-press
1873 1880
   "\C-c^" gnus-article-refer-article
1874 1881
   "h" gnus-article-show-summary
1875 1882
   "s" gnus-article-show-summary
1876 1883
   "\C-c\C-m" gnus-article-mail
1877 1884
   "?" gnus-article-describe-briefly
1878  
-  gnus-mouse-2 gnus-article-push-button
1879  
-  "\r" gnus-article-press-button
1880  
-  "\t" gnus-article-next-button
1881  
-  "\M-\t" gnus-article-prev-button
1882 1885
   "e" gnus-article-edit
1883 1886
   "<" beginning-of-buffer
1884 1887
   ">" end-of-buffer
@@ -2179,7 +2182,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
2179 2182
 (defun gnus-insert-mime-button (handle)
2180 2183
   (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
2181 2184
 	(gnus-tmp-type (car (mm-handle-type handle)))
2182  
-	(gnus-tmp-description (mm-handle-description handle)))
  2185
+	(gnus-tmp-description (mm-handle-description handle))
  2186
+	b e)
2183 2187
     (setq gnus-tmp-name
2184 2188
       (if gnus-tmp-name
2185 2189
 	  (concat " (" gnus-tmp-name ")")
@@ -2188,12 +2192,19 @@ If ALL-HEADERS is non-nil, no headers are hidden."
2188 2192
       (if gnus-tmp-description
2189 2193
 	  (concat " (" gnus-tmp-description ")")
2190 2194
 	""))
  2195
+    (setq b (point))
2191 2196
     (gnus-eval-format
2192 2197
      gnus-mime-button-line-format gnus-mime-button-line-format-alist
2193 2198
      `(local-map ,gnus-mime-button-map
2194 2199
 		 keymap ,gnus-mime-button-map
2195 2200
 		 gnus-callback mm-display-part
2196  
-		 gnus-data ,handle))))
  2201
+		 gnus-data ,handle))
  2202
+    (setq e (point))
  2203
+    (widget-convert-text 'link b e b e :action 'gnus-widget-press-button)))
  2204
+
  2205
+(defun gnus-widget-press-button (elems el)
  2206
+  (goto-char (widget-get elems :from))
  2207
+  (gnus-article-press-button))
2197 2208
 
2198 2209
 (defun gnus-display-mime ()
2199 2210
   "Insert MIME buttons in the buffer."
@@ -2666,10 +2677,10 @@ If given a prefix, show the hidden text instead."
2666 2677
 	  (let (buffer-read-only)
2667 2678
 	    (erase-buffer)
2668 2679
 	    (insert-buffer-substring gnus-article-buffer))
2669  
-	  (setq gnus-original-article (cons group article))))
  2680
+	  (setq gnus-original-article (cons group article)))
2670 2681
 
2671  
-      ;; Decode charsets.
2672  
-      (run-hooks 'gnus-article-decode-hook)
  2682
+	;; Decode charsets.
  2683
+	(run-hooks 'gnus-article-decode-hook))
2673 2684
       
2674 2685
       ;; Update sparse articles.
2675 2686
       (when (and do-update-line
@@ -2943,40 +2954,6 @@ call it with the value of the `gnus-data' text property."
2943 2954
     (when fun
2944 2955
       (funcall fun data))))
2945 2956
 
2946  
-(defun gnus-article-prev-button (n)
2947  
-  "Move point to N buttons backward.
2948  
-If N is negative, move forward instead."
2949  
-  (interactive "p")
2950  
-  (gnus-article-next-button (- n)))
2951  
-
2952  
-(defun gnus-article-next-button (n)
2953  
-  "Move point to N buttons forward.
2954  
-If N is negative, move backward instead."
2955  
-  (interactive "p")
2956  
-  (let ((function (if (< n 0) 'previous-single-property-change
2957  
-		    'next-single-property-change))
2958  
-	(inhibit-point-motion-hooks t)
2959  
-	(backward (< n 0))
2960  
-	(limit (if (< n 0) (point-min) (point-max))))
2961  
-    (setq n (abs n))
2962  
-    (while (and (not (= limit (point)))
2963  
-		(> n 0))
2964  
-      ;; Skip past the current button.
2965  
-      (when (get-text-property (point) 'gnus-callback)
2966  
-	(goto-char (funcall function (point) 'gnus-callback nil limit)))
2967  
-      ;; Go to the next (or previous) button.
2968  
-      (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
2969  
-      ;; Put point at the start of the button.
2970  
-      (when (and backward (not (get-text-property (point) 'gnus-callback)))
2971  
-	(goto-char (funcall function (point) 'gnus-callback nil limit)))
2972  
-      ;; Skip past intangible buttons.
2973  
-      (when (get-text-property (point) 'intangible)
2974  
-	(incf n))
2975  
-      (decf n))
2976  
-    (unless (zerop n)
2977  
-      (gnus-message 5 "No more buttons"))
2978  
-    n))
2979  
-
2980 2957
 (defun gnus-article-highlight (&optional force)
2981 2958
   "Highlight current article.
2982 2959
 This function calls `gnus-article-highlight-headers',
@@ -3159,7 +3136,9 @@ specified by `gnus-button-alist'."
3159 3136
    (nconc (and gnus-article-mouse-face
3160 3137
 	       (list gnus-mouse-face-prop gnus-article-mouse-face))
3161 3138
 	  (list 'gnus-callback fun)
3162  
-	  (and data (list 'gnus-data data)))))
  3139
+	  (and data (list 'gnus-data data))))
  3140
+  (widget-convert-text 'link from to from to
  3141
+		       :action 'gnus-widget-press-button))
3163 3142
 
3164 3143
 ;;; Internal functions:
3165 3144
 
3  lisp/gnus-cache.el
@@ -396,7 +396,6 @@ Returns the list of articles removed."
396 396
 	    (cons group
397 397
 		  (set-buffer (gnus-get-buffer-create
398 398
 			       " *gnus-cache-overview*"))))
399  
-      (buffer-disable-undo (current-buffer))
400 399
       ;; Insert the contents of this group's cache overview.
401 400
       (erase-buffer)
402 401
       (let ((file (gnus-cache-file-name group ".overview")))
@@ -488,7 +487,6 @@ Returns the list of articles removed."
488 487
     (gnus-cache-save-buffers)
489 488
     (save-excursion
490 489
       (set-buffer cache-buf)
491  
-      (buffer-disable-undo (current-buffer))
492 490
       (erase-buffer)
493 491
       (insert-file-contents (or file (gnus-cache-file-name group ".overview")))
494 492
       (goto-char (point-min))
@@ -518,7 +516,6 @@ Returns the list of articles removed."
518 516
   (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
519 517
     (save-excursion
520 518
       (set-buffer cache-buf)
521  
-      (buffer-disable-undo (current-buffer))
522 519
       (erase-buffer))
523 520
     (set-buffer nntp-server-buffer)
524 521
     (goto-char (point-min))
4  lisp/gnus-msg.el
@@ -362,7 +362,6 @@ header line with the old Message-ID."
362 362
   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
363 363
   ;; this buffer should be passed to all mail/news reply/post routines.
364 364
   (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
365  
-  (buffer-disable-undo gnus-article-copy)
366 365
   (save-excursion
367 366
     (set-buffer gnus-article-copy)
368 367
     (mm-enable-multibyte))
@@ -399,7 +398,7 @@ header line with the old Message-ID."
399 398
 			 (or (search-forward "\n\n" nil t) (point)))
400 399
 	  ;; Insert the original article headers.
401 400
 	  (insert-buffer-substring gnus-original-article-buffer beg end)
402  
-	  (gnus-article-decode-encoded-words)))
  401
+	  (article-decode-encoded-words)))
403 402
       gnus-article-copy)))
404 403
 
405 404
 (defun gnus-post-news (post &optional group header article-buffer yank subject
@@ -832,7 +831,6 @@ The source file has to be in the Emacs load path."
832 831
     ;; Go through all the files looking for non-default values for variables.
833 832
     (save-excursion
834 833
       (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
835  
-      (buffer-disable-undo (current-buffer))
836 834
       (while files
837 835
 	(erase-buffer)
838 836
 	(when (and (setq file (locate-library (pop files)))
1  lisp/gnus-start.el
@@ -2424,7 +2424,6 @@ If FORCE is non-nil, the .newsrc file is read."
2424 2424
       (gnus-message 7 "Reading slave newsrcs...")
2425 2425
       (save-excursion
2426 2426
 	(set-buffer (gnus-get-buffer-create " *gnus slave*"))
2427  
-	(buffer-disable-undo (current-buffer))
2428 2427
 	(setq slave-files
2429 2428
 	      (sort (mapcar (lambda (file)
2430 2429
 			      (list (nth 5 (file-attributes file)) file))
18  lisp/gnus-sum.el
@@ -761,6 +761,9 @@ mark:    The articles mark."
761 761
 The function is called with one parameter, the article header vector,
762 762
 which it may alter in any way.")
763 763
 
  764
+(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
  765
+  "Variable that says which function should be used to decode a string with encoded words.")
  766
+
764 767
 ;;; Internal variables
765 768
 
766 769
 (defvar gnus-article-mime-handles nil)
@@ -3052,8 +3055,10 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
3052 3055
 	  (setq header
3053 3056
 		(make-full-mail-header
3054 3057
 		 number			; number
3055  
-		 (mail-decode-encoded-word-string (gnus-nov-field)) ; subject
3056  
-		 (mail-decode-encoded-word-string (gnus-nov-field)) ; from
  3058
+		 (funcall gnus-decode-encoded-word-function
  3059
+			  (gnus-nov-field)) ; subject
  3060
+		 (funcall gnus-decode-encoded-word-function
  3061
+			  (gnus-nov-field)) ; from
3057 3062
 		 (gnus-nov-field)	; date
3058 3063
 		 (or (gnus-nov-field)
3059 3064
 		     (nnheader-generate-fake-message-id)) ; id
@@ -4396,13 +4401,15 @@ The resulting hash table is returned, or nil if no Xrefs were found."
4396 4401
 	    (progn
4397 4402
 	      (goto-char p)
4398 4403
 	      (if (search-forward "\nsubject: " nil t)
4399  
-		  (mail-decode-encoded-word-string (nnheader-header-value))
  4404
+		  (funcall gnus-decode-encoded-word-function
  4405
+			   (nnheader-header-value))
4400 4406
 		"(none)"))
4401 4407
 	    ;; From.
4402 4408
 	    (progn
4403 4409
 	      (goto-char p)
4404 4410
 	      (if (search-forward "\nfrom: " nil t)
4405  
-		  (mail-decode-encoded-word-string (nnheader-header-value))
  4411
+		  (funcall gnus-decode-encoded-word-function
  4412
+			   (nnheader-header-value))
4406 4413
 		"(nobody)"))
4407 4414
 	    ;; Date.
4408 4415
 	    (progn
@@ -6928,7 +6935,7 @@ and `request-accept' functions."
6928 6935
 	   (set-buffer copy-buf)
6929 6936
 	   (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
6930 6937
 	     (gnus-request-accept-article
6931  
-	      to-newsgroup select-method (not articles)))))
  6938
+	      to-newsgroup select-method (not articles) t))))
6932 6939
 	;; Crosspost the article.
6933 6940
 	((eq action 'crosspost)
6934 6941
 	 (let ((xref (message-tokenize-header
@@ -7136,7 +7143,6 @@ latter case, they will be copied into the relevant groups."
7136 7143
 	(error "Can't read %s" file))
7137 7144
     (save-excursion
7138 7145
       (set-buffer (gnus-get-buffer-create " *import file*"))
7139  
-      (buffer-disable-undo (current-buffer))
7140 7146
       (erase-buffer)
7141 7147
       (insert-file-contents file)
7142 7148
       (goto-char (point-min))
3  lisp/gnus.el
@@ -250,7 +250,7 @@ is restarted, and sometimes reloaded."
250 250
   :link '(custom-manual "(gnus)Exiting Gnus")
251 251
   :group 'gnus)
252 252
 
253  
-(defconst gnus-version-number "0.29"
  253
+(defconst gnus-version-number "0.30"
254 254
   "Version number for this version of Gnus.")
255 255
 
256 256
 (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
@@ -781,7 +781,6 @@ used to 899, you would say something along these lines:
781 781
       (and (file-readable-p gnus-nntpserver-file)
782 782
 	   (save-excursion
783 783
 	     (set-buffer (gnus-get-buffer-create " *gnus nntp*"))
784  
-	     (buffer-disable-undo (current-buffer))
785 784
 	     (insert-file-contents gnus-nntpserver-file)
786 785
 	     (let ((name (buffer-string)))
787 786
 	       (prog1
1  lisp/mail-parse.el
@@ -51,6 +51,7 @@
51 51
 (defalias 'mail-header-parse-addresses 'drums-parse-addresses)
52 52
 (defalias 'mail-header-parse-date 'drums-parse-date)
53 53
 (defalias 'mail-narrow-to-head 'drums-narrow-to-header)
  54
+(defalias 'mail-quote-string 'drums-quote-string)
54 55
 
55 56
 (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field)
56 57
 (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
1  lisp/mailcap.el
@@ -294,6 +294,7 @@ not.")
294 294
 (defun mailcap-parse-mailcaps (&optional path force)
295 295
   "Parse out all the mailcaps specified in a unix-style path string PATH.
296 296
 If FORCE, re-parse even if already parsed."
  297
+  (interactive)
297 298
   (when (or (not mailcap-parsed-p)
298 299
 	    force)
299 300
     (cond
4  lisp/message.el
@@ -40,6 +40,7 @@
40 40
   (require 'mailabbrev))
41 41
 (require 'mail-parse)
42 42
 (require 'mm-bodies)
  43
+(require 'mm-encode)
43 44
 
44 45
 (defgroup message '((user-mail-address custom-variable)
45 46
 		    (user-full-name custom-variable))
@@ -2556,7 +2557,6 @@ to find out how to use this."
2556 2557
 	list file)
2557 2558
     (save-excursion
2558 2559
       (set-buffer (get-buffer-create " *message temp*"))
2559  
-      (buffer-disable-undo (current-buffer))
2560 2560
       (erase-buffer)
2561 2561
       (insert-buffer-substring buf)
2562 2562
       (save-restriction
@@ -3548,7 +3548,6 @@ responses here are directed to other newsgroups."))
3548 3548
 	  (error "This article is not yours"))
3549 3549
 	;; Make control message.
3550 3550
 	(setq buf (set-buffer (get-buffer-create " *message cancel*")))
3551  
-	(buffer-disable-undo (current-buffer))
3552 3551
 	(erase-buffer)
3553 3552
 	(insert "Newsgroups: " newsgroups "\n"
3554 3553
 		"From: " (message-make-from) "\n"
@@ -3739,7 +3738,6 @@ Optional NEWS will use news to forward instead of mail."
3739 3738
 	  beg)
3740 3739
       ;; We first set up a normal mail buffer.
3741 3740
       (set-buffer (get-buffer-create " *message resend*"))
3742  
-      (buffer-disable-undo (current-buffer))
3743 3741
       (erase-buffer)
3744 3742
       (message-setup `((To . ,address)))
3745 3743
       ;; Insert our usual headers.
37  lisp/mm-decode.el
@@ -63,6 +63,7 @@
63 63
 
64 64
 (defvar mm-dissection-list nil)
65 65
 (defvar mm-last-shell-command "")
  66
+(defvar mm-content-id-alist nil)
66 67
 
67 68
 ;;; Convenience macros.
68 69
 
@@ -86,7 +87,7 @@
86 87
 (defun mm-dissect-buffer (&optional no-strict-mime)
87 88
   "Dissect the current buffer and return a list of MIME handles."
88 89
   (save-excursion
89  
-    (let (ct ctl type subtype cte cd description)
  90
+    (let (ct ctl type subtype cte cd description id result)
90 91
       (save-restriction
91 92
 	(mail-narrow-to-head)
92 93
 	(when (and (or no-strict-mime
@@ -95,22 +96,28 @@
95 96
 	  (setq ctl (mail-header-parse-content-type ct)
96 97
 		cte (mail-fetch-field "content-transfer-encoding")
97 98
 		cd (mail-fetch-field "content-disposition")
98  
-		description (mail-fetch-field "content-description"))))
  99
+		description (mail-fetch-field "content-description")
  100
+		id (mail-fetch-field "content-id"))))
99 101
       (when ctl
100 102
 	(setq type (split-string (car ctl) "/"))
101 103
 	(setq subtype (cadr type)
102 104
 	      type (pop type))
103  
-	(cond
104  
-	 ((equal type "multipart")
105  
-	  (mm-dissect-multipart ctl))
106  
-	 (t
107  
-	  (mm-dissect-singlepart
108  
-	   ctl
109  
-	   (and cte (intern (downcase (mail-header-remove-whitespace
110  
-				       (mail-header-remove-comments
111  
-					cte)))))
112  
-	   no-strict-mime
113  
-	   (and cd (mail-header-parse-content-disposition cd)))))))))
  105
+	(setq
  106
+	 result
  107
+	 (cond
  108
+	  ((equal type "multipart")
  109
+	   (mm-dissect-multipart ctl))
  110
+	  (t
  111
+	   (mm-dissect-singlepart
  112
+	    ctl
  113
+	    (and cte (intern (downcase (mail-header-remove-whitespace
  114
+					(mail-header-remove-comments
  115
+					 cte)))))
  116
+	    no-strict-mime
  117
+	    (and cd (mail-header-parse-content-disposition cd))))))
  118
+	(when id
  119
+	  (push (cons id result) mm-content-id-alist))
  120
+	result))))
114 121
 
115 122
 (defun mm-dissect-singlepart (ctl cte &optional force cdl description)
116 123
   (when (or force
@@ -347,6 +354,10 @@ This overrides entries in the mailcap file."
347 354
 	(pop h)))
348 355
     result))
349 356
 
  357
+(defun mm-get-content-id (id)
  358
+  "Return the handle(s) referred to by ID."
  359
+  (cdr (assoc id mm-content-id-alist)))
  360
+
350 361
 (provide 'mm-decode)
351 362
 
352 363
 ;; mm-decode.el ends here
10  lisp/mm-encode.el
@@ -24,6 +24,16 @@
24 24
 
25 25
 ;;; Code:
26 26
 
  27
+(require 'mail-parse)
  28
+
  29
+(defun mm-insert-rfc822-headers (charset encoding)
  30
+  "Insert text/plain headers with CHARSET and ENCODING."
  31
+  (insert "MIME-Version: 1.0\n")
  32
+  (insert "Content-Type: text/plain; charset="
  33
+	  (mail-quote-string (downcase (symbol-name charset))) "\n")
  34
+  (insert "Content-Transfer-Encoding: "
  35
+	  (downcase (symbol-name encoding)) "\n"))
  36
+
27 37
 (provide 'mm-encode)
28 38
 
29 39
 ;;; mm-encode.el ends here
17  lisp/mm-util.el
@@ -24,6 +24,9 @@
24 24
 
25 25
 ;;; Code:
26 26
 
  27
+(defvar mm-default-coding-system nil
  28
+  "The default coding system to use.")  
  29
+
27 30
 (defvar mm-known-charsets '(iso-8859-1)
28 31
   "List of known charsets.")
29 32
 
@@ -160,17 +163,15 @@ used as the line break code type of the coding system."
160 163
   (when (fboundp 'set-buffer-multibyte)
161 164
     (set-buffer-multibyte t)))
162 165
 
163  
-(defun mm-insert-rfc822-headers (charset encoding)
164  
-  "Insert text/plain headers with CHARSET and ENCODING."
165  
-  (insert "MIME-Version: 1.0\n")
166  
-  (insert "Content-Type: text/plain; charset=\""
167  
-	  (downcase (symbol-name charset)) "\"\n")
168  
-  (insert "Content-Transfer-Encoding: "
169  
-	  (downcase (symbol-name encoding)) "\n"))
170  
-
171 166
 (defun mm-mime-charset (charset b e)
172 167
   (if (fboundp 'coding-system-get)
173 168
       (or
  169
+       (and
  170
+	mm-default-coding-system
  171
+	(let ((safe (coding-system-get mm-default-coding-system
  172
+				       'safe-charsets)))
  173
+	  (or (eq safe t) (memq charset safe)))
  174
+	(coding-system-get mm-default-coding-system 'mime-charset))
174 175
        (coding-system-get
175 176
 	(get-charset-property charset 'prefered-coding-system)
176 177
 	'mime-charset)
35  lisp/mm-view.el
@@ -70,24 +70,23 @@
70 70
 		 ,(set-marker (make-marker) (point-min))
71 71
 		 ,(set-marker (make-marker) (point-max)))))))))
72 72
      ((equal type "html")
73  
-      (save-window-excursion
74  
-	(save-excursion
75  
-	  (w3-do-setup)
76  
-	  (mm-with-unibyte-buffer
77  
-	    (insert-buffer-substring (mm-handle-buffer handle))
78  
-	    (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
79  
-	    (require 'url)
80  
-	    (save-window-excursion
81  
-	      (w3-region (point-min) (point-max))
82  
-	      (setq text (buffer-string))))
83  
-	  (let ((b (point)))
84  
-	    (insert text)
85  
-	    (mm-handle-set-undisplayer
86  
-	     handle
87  
-	     `(lambda ()
88  
-		(let (buffer-read-only)
89  
-		  (delete-region ,(set-marker (make-marker) b)
90  
-				 ,(set-marker (make-marker) (point))))))))))
  73
+      (save-excursion
  74
+	(w3-do-setup)
  75
+	(mm-with-unibyte-buffer
  76
+	  (insert-buffer-substring (mm-handle-buffer handle))
  77
+	  (mm-decode-content-transfer-encoding (mm-handle-encoding handle))
  78
+	  (require 'url)
  79
+	  (save-window-excursion
  80
+	    (w3-region (point-min) (point-max))
  81
+	    (setq text (buffer-string))))
  82
+	(let ((b (point)))
  83
+	  (insert text)
  84
+	  (mm-handle-set-undisplayer
  85
+	   handle
  86
+	   `(lambda ()
  87
+	      (let (buffer-read-only)
  88
+		(delete-region ,(set-marker (make-marker) b)
  89
+			       ,(set-marker (make-marker) (point)))))))))
91 90
      )))
92 91
 
93 92
 (defun mm-inline-audio (handle)
1  lisp/nndoc.el
@@ -289,7 +289,6 @@ from the document.")
289 289
       (setq nndoc-dissection-alist nil)
290 290
       (save-excursion
291 291
 	(set-buffer nndoc-current-buffer)
292  
-	(buffer-disable-undo (current-buffer))
293 292
 	(erase-buffer)
294 293
 	(if (stringp nndoc-address)
295 294
 	    (nnheader-insert-file-contents nndoc-address)
1  lisp/nndraft.el
@@ -80,7 +80,6 @@
80 80
     (let* ((buf (get-buffer-create " *draft headers*"))
81 81
 	   article)
82 82
       (set-buffer buf)
83  
-      (buffer-disable-undo (current-buffer))
84 83
       (erase-buffer)
85 84
       ;; We don't support fetching by Message-ID.
86 85
       (if (stringp (car articles))
1  lisp/nnfolder.el
@@ -328,7 +328,6 @@ time saver for large mailboxes.")
328 328
        (nnfolder-request-article article group server)
329 329
        (save-excursion
330 330
 	 (set-buffer buf)
331  
-	 (buffer-disable-undo (current-buffer))
332 331
 	 (erase-buffer)
333 332
 	 (insert-buffer-substring nntp-server-buffer)
334 333
 	 (goto-char (point-min))
2  lisp/nnheader.el
@@ -777,8 +777,6 @@ find-file-hooks, etc.
777 777
   `(let ((new (generate-new-buffer " *nnheader replace*"))
778 778
 	 (cur (current-buffer))
779 779
 	 (start (point-min)))
780  
-     (set-buffer new)
781  
-     (buffer-disable-undo (current-buffer))
782 780
      (set-buffer cur)
783 781
      (goto-char (point-min))
784 782
      (while (,(if regexp 're-search-forward 'search-forward)
2  lisp/nnmail.el
@@ -986,7 +986,6 @@ FUNC will be called with the buffer narrowed to each mail."
986 986
     (save-excursion
987 987
       ;; Insert the incoming file.
988 988
       (set-buffer (get-buffer-create " *nnmail incoming*"))
989  
-      (buffer-disable-undo (current-buffer))
990 989
       (erase-buffer)
991 990
       (nnheader-insert-file-contents incoming)
992 991
       (unless (zerop (buffer-size))
@@ -1441,7 +1440,6 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
1441 1440
       (set-buffer
1442 1441
        (setq nnmail-cache-buffer
1443 1442
 	     (get-buffer-create " *nnmail message-id cache*")))
1444  
-      (buffer-disable-undo (current-buffer))
1445 1443
       (when (file-exists-p nnmail-message-id-cache-file)
1446 1444
 	(nnheader-insert-file-contents nnmail-message-id-cache-file))
1447 1445
       (set-buffer-modified-p nil)
1  lisp/nnmbox.el
@@ -265,7 +265,6 @@
265 265
      (nnmbox-request-article article group server)
266 266
      (save-excursion
267 267
        (set-buffer buf)
268  
-       (buffer-disable-undo (current-buffer))
269 268
        (erase-buffer)
270 269
        (insert-buffer-substring nntp-server-buffer)
271 270
        (goto-char (point-min))
1  lisp/nnml.el
@@ -502,7 +502,6 @@ all.  This may very well take some time.")
502 502
 (defun nnml-find-group-number (id)
503 503
   (save-excursion
504 504
     (set-buffer (get-buffer-create " *nnml id*"))
505  
-    (buffer-disable-undo (current-buffer))
506 505
     (let ((alist nnml-group-alist)
507 506
 	  number)
508 507
       ;; We want to look through all .overview files, but we want to
1  lisp/nnsoup.el
@@ -752,7 +752,6 @@ backend for the messages.")
752 752
 				 (string-to-int (match-string 1 f2)))))))
753 753
 	active group lines ident elem min)
754 754
     (set-buffer (get-buffer-create " *nnsoup work*"))
755  
-    (buffer-disable-undo (current-buffer))
756 755
     (while files
757 756
       (nnheader-message 5 "Doing %s..." (car files))
758 757
       (erase-buffer)
1  lisp/nnspool.el
@@ -419,7 +419,6 @@ there.")
419 419
 (defun nnspool-find-id (id)
420 420
   (save-excursion
421 421
     (set-buffer (get-buffer-create " *nnspool work*"))
422  
-    (buffer-disable-undo (current-buffer))
423 422
     (erase-buffer)
424 423
     (ignore-errors
425 424
       (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
46  lisp/rfc2047.el
@@ -30,6 +30,7 @@
30 30
 	(require 'base64))))
31 31
 (require 'qp)
32 32
 (require 'mm-util)
  33
+(require 'drums)
33 34
 
34 35
 (defvar rfc2047-default-charset 'iso-8859-1
35 36
   "Default MIME charset -- does not need encoding.")
@@ -107,6 +108,7 @@ Should be called narrowed to the head of the message."
107 108
   (interactive "*")
108 109
   (when (featurep 'mule)
109 110
     (save-excursion
  111
+      (goto-char (point-min))
110 112
       (let ((alist rfc2047-header-encoding-alist)
111 113
 	    elem method)
112 114
 	(while (not (eobp))
@@ -146,7 +148,7 @@ Should be called narrowed to the head of the message."
146 148
     (save-restriction
147 149
       (narrow-to-region b e)
148 150
       (goto-char (point-min))
149  
-      (while (re-search-forward "[^ \t\n]+" nil t)
  151
+      (while (re-search-forward (concat "[^" drums-tspecials " \t\n]+") nil t)
150 152
 	(push
151 153
 	 (list (match-beginning 0) (match-end 0)
152 154
 	       (car
@@ -187,28 +189,31 @@ Should be called narrowed to the head of the message."
187 189
 		       'B))
188 190
 	 (start (concat
189 191
 		 "=?" (downcase (symbol-name mime-charset)) "?"
190  
-		 (downcase (symbol-name encoding)) "?")))
  192
+		 (downcase (symbol-name encoding)) "?"))
  193
+	 (first t))
191 194
     (save-restriction
192 195
       (narrow-to-region b e)
193 196
       (mm-encode-coding-region b e mime-charset)
194 197
       (funcall (cdr (assq encoding rfc2047-encoding-function-alist))
195 198
 	       (point-min) (point-max))
196 199
       (goto-char (point-min))
197  
-      (insert start)
198  
-      (goto-char (point-max))
199  
-      (insert "?=")
200  
-      ;; Encoded words can't be more than 75 chars long, so we have to
201  
-      ;; split the long ones up.
202  
-      (end-of-line)
203  
-      (while (> (current-column) 74)
204  
-	(beginning-of-line)
205  
-	(forward-char 73)
206  
-	(insert "?=\n " start)
207  
-	(end-of-line)))))
  200
+      (while (not (eobp))
  201
+	(unless first
  202
+	  (insert " "))
  203
+	(setq first nil)
  204
+	(insert start)
  205
+	(end-of-line)
  206
+	(insert "?=")
  207
+	(forward-line 1)))))
208 208
 
209 209
 (defun rfc2047-b-encode-region (b e)
210 210
   "Encode the header contained in REGION with the B encoding."
211  
-  (base64-encode-region b e t))
  211
+  (base64-encode-region b e t)
  212
+  (goto-char (point-min))
  213
+  (while (not (eobp))
  214
+    (goto-char (min (point-max) (+ 64 (point))))
  215
+    (unless (eobp)
  216
+      (insert "\n"))))
212 217
 
213 218
 (defun rfc2047-q-encode-region (b e)
214 219
   "Encode the header contained in REGION with the Q encoding."
@@ -219,15 +224,22 @@ Should be called narrowed to the head of the message."
219 224
 	(while alist
220 225
 	  (when (looking-at (caar alist))
221 226
 	    (quoted-printable-encode-region b e nil (cdar alist))
222  
-	    (subst-char-in-region (point-min) (point-max) ?  ?_))
223  
-	  (pop alist))))))
  227
+	    (subst-char-in-region (point-min) (point-max) ?  ?_)
  228
+	    (setq alist nil))
  229
+	  (pop alist))
  230
+	(goto-char (point-min))
  231
+	(while (not (eobp))
  232
+	  (forward-char 64)
  233
+	  (search-backward "=" nil (- (point) 2))
  234
+	  (unless (eobp)
  235
+	    (insert "\n")))))))
224 236
 
225 237
 ;;;
226 238
 ;;; Functions for decoding RFC2047 messages
227 239
 ;;;
228 240
 
229 241
 (defvar rfc2047-encoded-word-regexp
230  
-  "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ ]+\\)\\?=")
  242
+  "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
231 243
 
232 244
 (defun rfc2047-decode-region (start end)
233 245
   "Decode MIME-encoded words in region between START and END."
4  texi/ChangeLog
... ...
@@ -1,3 +1,7 @@
  1
+1998-09-13 08:58:56  Lars Magne Ingebrigtsen  <larsi@gnus.org>
  2
+
  3
+	* dir (File): Updated.
  4
+
1 5
 1998-09-12 08:53:05  Lars Magne Ingebrigtsen  <larsi@gnus.org>
2 6
 
3 7
 	* emacs-mime.texi: New file.
4  texi/Makefile.in
@@ -31,7 +31,7 @@ most: texi2latex.elc latex latexps
31 31
 	  makeinfo -o $* $<; \
32 32
 	fi
33 33
 
34  
-dvi: gnus.dvi message.dvi refcard.dvi
  34
+dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi
35 35
 
36 36
 .texi.dvi :
37 37
 	$(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi
@@ -115,7 +115,7 @@ distclean:
115 115
 
116 116
 install:
117 117
 	$(SHELL) $(top_srcdir)/mkinstalldirs $(infodir)
118  
-	@for file in gnus message; do \
  118
+	@for file in gnus message emacs-info; do \
119 119
 	  for ifile in `echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \
120 120
 	    if test -f $$ifile; then \
121 121
 	      echo " $(INSTALL_DATA) $$ifile $(infodir)/$$ifile"; \
5  texi/dir
@@ -5,5 +5,6 @@ File: dir	Node: Top	This is the Gnus Info tree
5 5
 
6 6
 * Menu: 
7 7
 
8  
-* Gnus: (gnus).		The news reader Gnus.
9  
-* Message: (message).	The Message sending thingamabob.
  8
+* Gnus: (gnus).			The news reader Gnus.
  9
+* Message: (message).		The Message sending thingamabob.
  10
+* Emacs MIME: (emacs-mime).	Libraries for handling MIME.
65  texi/emacs-mime.texi
@@ -6,7 +6,7 @@
6 6
 @synindex vr cp
7 7
 @synindex pg cp
8 8
 @c @direntry
9  
-@c * Emacs Mime: (emacs-mime).   The MIME de/composition library.
  9
+@c * Emacs MIME: (emacs-mime).   The MIME de/composition library.
10 10
 @c @end direntry
11 11
 @iftex
12 12
 @finalout
@@ -68,7 +68,7 @@ into another language, under the above conditions for modified versions.
68 68
 @end tex
69 69
 
70 70
 @node Top
71  
-@top Emacs Mime
  71
+@top Emacs MIME
72 72
 
73 73
 This manual documents the libraries used to compose and display
74 74
 @sc{mime} messages.
@@ -98,8 +98,8 @@ read at least RFC2045 and RFC2047.
98 98
 This chapter describes the basic, ground-level functions for parsing and
99 99
 handling.  Covered here is parsing @code{From} lines, removing comments
100 100
 from header lines, decoding encoded words, parsing date headers and so
101  
-on.  High-level functionality is dealt with in the @pxref{Decoding and
102  
-Viewing} chapter.
  101
+on.  High-level functionality is dealt with in the next chapter
  102
+(@pxref{Decoding and Viewing}).
103 103
 
104 104
 @menu
105 105
 * mail-parse::   The generalized @sc{mime} and mail interface.
@@ -109,6 +109,7 @@ Viewing} chapter.
109 109
 * time-date::    Functions for parsing dates and manipulating time.
110 110
 * qp::           Quoted-Printable en/decoding.
111 111
 * base64::       Base64 en/decoding.
  112
+* mailcap::      How parts are displayed is specified by the @file{.mailcap} file
112 113
 @end menu
113 114
 
114 115
 
@@ -164,7 +165,6 @@ Here's an example:
164 165
 @example
165 166
 (mail-header-parse-content-type
166 167
  "image/gif; name=\"b980912.gif\"")
167  
-
168 168
 => ("image/gif" (name . "b980912.gif"))
169 169
 @end example
170 170
 
@@ -181,7 +181,6 @@ Returns the value of the attribute.
181 181
 @example
182 182
 (mail-content-type-get
183 183
  '("image/gif" (name . "b980912.gif")) 'name)
184  
-
185 184
 => "b980912.gif"
186 185
 @end example
187 186
 
@@ -192,7 +191,6 @@ Return a comment-free version of a header.
192 191
 @example
193 192
 (mail-header-remove-comments
194 193
  "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)")
195  
-
196 194
 => "Gnus/5.070027  "
197 195
 @end example
198 196
 
@@ -236,7 +234,7 @@ the one described above.
236 234
 @example
237 235
 (mail-header-parse-addresses
238 236
  "Hrvoje Niksic <hniksic@@srce.hr>, Steinar Bang <sb@@metis.no>")
239  
- => (("hniksic@@srce.hr" . "Hrvoje Niksic")
  237
+=> (("hniksic@@srce.hr" . "Hrvoje Niksic")
240 238
      ("sb@@metis.no" . "Steinar Bang"))
241 239
 @end example
242 240
 
@@ -593,6 +591,45 @@ decoded, @code{nil} is returned.
593 591
 @end table
594 592
 
595 593
 
  594
+@node mailcap
  595
+@section mailcap
  596
+
  597
+The @file{~/.mailcap} file is parsed by most @sc{mime}-aware message
  598
+handlers and describes how elements are supposed to be displayed.
  599
+Here's an example file:
  600
+
  601
+@example
  602
+image/*; xv -8 %s
  603
+audio/x-pn-realaudio; rvplayer %s
  604
+@end example
  605
+
  606
+This says that all image files should be displayed with @samp{xv}, and
  607
+that realaudio files should be played by @samp{rvplayer}.
  608
+
  609
+The @code{mailcap} library parses this file, and provides functions for
  610
+matching types.
  611
+
  612
+@table @code
  613
+@item mailcap-mime-data
  614
+@vindex mailcap-mime-data
  615
+This variable is an alist of alists containing backup viewing rules.
  616
+
  617
+@end table
  618
+
  619
+Interface functions:
  620
+
  621
+@table @code
  622
+@item mailcap-parse-mailcaps
  623
+@findex mailcap-parse-mailcaps
  624
+Parse the @code{~/.mailcap} file.
  625
+
  626
+@item mailcap-mime-info
  627
+Takes a @sc{mime} type as its argument and returns the matching viewer.
  628
+
  629
+@end table
  630
+
  631
+
  632
+
596 633
 
597 634
 @node Decoding and Viewing
598 635
 @chapter Decoding and Viewing
@@ -602,12 +639,12 @@ higher level.
602 639
 
603 640
 The main idea is to first analyze a @sc{mime} article, and then allow
604 641
 other programs to do things based on the list of @dfn{handles} that are
605  
-returned as a result of this analyze.
  642
+returned as a result of this analyzation.
606 643
 
607 644
 @menu
608  
-* Dissection::          Analyzing a @sc{mime} message.
609  
-* Handles::             Handle manipulations.
610  
-* Display::             Displaying handles.
  645
+* Dissection::  Analyzing a @sc{mime} message.
  646
+* Handles::     Handle manipulations.
  647
+* Display::     Displaying handles.
611 648
 @end menu
612 649
 
613 650
 
@@ -659,6 +696,9 @@ Return the parsed @code{Content-Disposition} of the part.
659 696
 @findex mm-handle-disposition
660 697
 Return the description of the part.
661 698
 
  699
+@item mm-get-content-id
  700
+Returns the handle(s) referred to by @code{Content-ID}.
  701
+
662 702
 @end table
663 703
 
664 704
 
@@ -703,6 +743,7 @@ Prompt for a mailcap method to use to view the part.
703 743
 @end table
704 744
  
705 745
 
  746
+ 
706 747
 @node Index
707 748
 @chapter Index
708 749
 @printindex cp
6  texi/gnus.texi
... ...
@@ -1,7 +1,7 @@
1 1
 \input texinfo                  @c -*-texinfo-*-
2 2
 
3 3
 @setfilename gnus
4  
-@settitle Pterodactyl Gnus 0.29 Manual
  4
+@settitle Pterodactyl Gnus 0.30 Manual
5 5
 @synindex fn cp
6 6
 @synindex vr cp
7 7
 @synindex pg cp
@@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions.
318 318
 @tex
319 319
 
320 320
 @titlepage
321  
-@title Pterodactyl Gnus 0.29 Manual
  321
+@title Pterodactyl Gnus 0.30 Manual
322 322
 
323 323
 @author by Lars Magne Ingebrigtsen
324 324
 @page
@@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local
354 354
 spool or your mbox file.  All at the same time, if you want to push your
355 355
 luck.
356 356
 
357  
-This manual corresponds to Pterodactyl Gnus 0.29.
  357
+This manual corresponds to Pterodactyl Gnus 0.30.
358 358
 
359 359
 @end ifinfo
360 360
 
6  texi/message.texi
... ...
@@ -1,7 +1,7 @@
1 1
 \input texinfo                  @c -*-texinfo-*-
2 2
 
3 3
 @setfilename message
4  
-@settitle Pterodactyl Message 0.29 Manual
  4
+@settitle Pterodactyl Message 0.30 Manual
5 5
 @synindex fn cp
6 6
 @synindex vr cp
7 7
 @synindex pg cp
@@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions.
42 42
 @tex
43 43
 
44 44
 @titlepage
45  
-@title Pterodactyl Message 0.29 Manual
  45
+@title Pterodactyl Message 0.30 Manual
46 46
 
47 47
 @author by Lars Magne Ingebrigtsen
48 48
 @page
@@ -83,7 +83,7 @@ Message mode buffers.
83 83
 * Key Index::         List of Message mode keys.
84 84
 @end menu
85 85
 
86  
-This manual corresponds to Pterodactyl Message 0.29.  Message is
  86
+This manual corresponds to Pterodactyl Message 0.30.  Message is
87 87
 distributed with the Gnus distribution bearing the same version number
88 88
 as this manual.
89 89
 

0 notes on commit 29d88dc

Please sign in to comment.
Something went wrong with that request. Please try again.