X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=8e5eb6aca959ec25d80fbbbd65b24af95c0a9b49;hb=8bee94245d027b46e8b93217dad7221ca12e48f2;hp=423b287b1c576e0415fe42424a5ba31957f833f3;hpb=66faad5855bdc7a0641cc1cfb8b697a000bf11d0;p=gnus

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 423b287b1..8e5eb6aca 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -148,7 +148,7 @@
 
 ;; Delete the current line (and the next N lines).
 (defmacro gnus-delete-line (&optional n)
-  `(delete-region (progn (beginning-of-line) (point))
+  `(delete-region (gnus-point-at-bol)
 		  (progn (forward-line ,(or n 1)) (point))))
 
 (defun gnus-byte-code (func)
@@ -198,6 +198,12 @@
 	(nnheader-narrow-to-headers)
 	(message-fetch-field field)))))
 
+(defun gnus-fetch-original-field (field)
+  "Fetch FIELD from the original version of the current article."
+  (with-current-buffer gnus-original-article-buffer
+    (gnus-fetch-field field)))
+
+
 (defun gnus-goto-colon ()
   (beginning-of-line)
   (let ((eol (gnus-point-at-eol)))
@@ -1019,6 +1025,34 @@ Return the modified alist."
       (while (search-backward "\\." nil t)
 	(delete-char 1)))))
 
+(defmacro gnus-with-output-to-file (file &rest body)
+  (let ((buffer (make-symbol "output-buffer"))
+        (size (make-symbol "output-buffer-size"))
+        (leng (make-symbol "output-buffer-length")))
+    `(let* ((print-quoted t)
+            (print-readably t)
+            (print-escape-multibyte nil)
+            print-level 
+            print-length
+            (,size 131072)
+            (,buffer (make-string ,size 0))
+            (,leng 0)
+            (append nil)
+            (standard-output
+	     (lambda (c)
+	       (aset ,buffer ,leng c)
+	       (if (= ,size (setq ,leng (1+ ,leng)))
+		   (progn (write-region ,buffer nil ,file append 'no-msg)
+			  (setq ,leng 0
+				append t))))))
+       ,@body
+       (when (> ,leng 0)
+	 (write-region (substring ,buffer 0 ,leng) nil ,file
+		       append 'no-msg)))))
+
+(put 'gnus-with-output-to-file 'lisp-indent-function 1)
+(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
+
 (if (fboundp 'union)
     (defalias 'gnus-union 'union)
   (defun gnus-union (l1 l2)
@@ -1083,8 +1117,11 @@ Setting it to nil has no effect after first time running
 	    (require 'byte-optimize)
 	  (error))
 	(require 'bytecomp)
-	(defalias 'gnus-byte-compile 'byte-compile)
-	(byte-compile form))
+	(defalias 'gnus-byte-compile
+	  (lambda (form)
+	    (let ((byte-compile-warnings '(unresolved callargs redefine)))
+	      (byte-compile form))))
+	(gnus-byte-compile form))
     form))
 
 (defun gnus-remassoc (key alist)
@@ -1236,10 +1273,10 @@ CHOICE is a list of the choice char and help message at IDX."
     (save-window-excursion
       (save-excursion
 	(while (not tchar)
-	  (message "%s (%s?): "
+	  (message "%s (%s): "
 		   prompt
 		   (mapconcat (lambda (s) (char-to-string (car s)))
-			      choice ""))
+			      choice ", "))
 	  (setq tchar (read-char))
 	  (when (not (assq tchar choice))
 	    (setq tchar nil)
@@ -1320,4 +1357,38 @@ Return nil otherwise."
 
 (provide 'gnus-util)
 
+(defmacro gnus-mapcar (function seq1 &rest seqs2_n)
+  "Apply FUNCTION to each element of the sequences, and make a list of the results.
+If there are several sequences, FUNCTION is called with that many arguments,
+and mapping stops as soon as the shortest sequence runs out.  With just one
+sequence, this is like `mapcar'.  With several, it is like the Common Lisp
+`mapcar' function extended to arbitrary sequence types."
+
+  (if seqs2_n
+      (let* ((seqs (cons seq1 seqs2_n))
+	     (cnt 0)
+	     (heads (mapcar (lambda (seq)
+			      (make-symbol (concat "head"
+						   (int-to-string
+						    (setq cnt (1+ cnt))))))
+			    seqs))
+	     (result (make-symbol "result"))
+	     (result-tail (make-symbol "result-tail")))
+	`(let* ,(let* ((bindings (cons nil nil))
+		       (heads heads))
+		  (nconc bindings (list (list result '(cons nil nil))))
+		  (nconc bindings (list (list result-tail result)))
+		  (while heads
+		    (nconc bindings (list (list (pop heads) (pop seqs)))))
+		  (cdr bindings))
+	   (while (and ,@heads)
+	     (setcdr ,result-tail (cons (funcall ,function
+						 ,@(mapcar (lambda (h) (list 'car h))
+							   heads))
+					nil))
+	     (setq ,result-tail (cdr ,result-tail)
+		   ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads))))
+	   (cdr ,result)))
+    `(mapcar ,function ,seq1)))
+
 ;;; gnus-util.el ends here