X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-fun.el;h=a3d41c6ce5c679fbb2cc8b1f8403a13149265bc1;hp=8ca16e11b6be01b03899a0a033ad484b647595e5;hb=a5a25556d5fa359de6c402860fac2f5cf2e3d423;hpb=b620dcac7922db1325ca78827d53ed69cac779d6

diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
index 8ca16e11b..a3d41c6ce 100644
--- a/lisp/gnus-fun.el
+++ b/lisp/gnus-fun.el
@@ -36,7 +36,12 @@
   :type 'string)
 
 (defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
-  "Command for converting a GIF to an X-Face."
+  "Command for converting an image to an X-Face."
+  :group 'gnus-fun
+  :type 'string)
+
+(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng"
+  "Command for converting an image to an X-Face."
   :group 'gnus-fun
   :type 'string)
 
@@ -55,7 +60,7 @@ Output to the current buffer, replace text, and don't mingle error."
 
 ;;;###autoload
 (defun gnus-random-x-face ()
-  "Insert a random X-Face header from `gnus-x-face-directory'."
+  "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
   (interactive)
   (when (file-exists-p gnus-x-face-directory)
     (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
@@ -65,14 +70,73 @@ Output to the current buffer, replace text, and don't mingle error."
 	 (format gnus-convert-pbm-to-x-face-command
 		 (shell-quote-argument file)))))))
 
+;;;###autoload
+(defun gnus-insert-random-x-face-header ()
+  "Insert a random X-Face header from `gnus-x-face-directory'."
+  (interactive)
+  (let ((data (gnus-random-x-face)))
+    (save-excursion
+      (message-goto-eoh)
+      (if data
+	  (insert "X-Face: " data)
+	(message
+	 "No face returned by `gnus-random-x-face'.  Does %s/*.pbm exist?"
+	 gnus-x-face-directory)))))
+
 ;;;###autoload
 (defun gnus-x-face-from-file (file)
   "Insert an X-Face header based on an image file."
-  (interactive "fImage file name:" )
+  (interactive "fImage file name: ")
   (when (file-exists-p file)
     (gnus-shell-command-to-string
      (format gnus-convert-image-to-x-face-command
-	     (shell-quote-argument file)))))
+	     (shell-quote-argument (expand-file-name file))))))
+
+;;;###autoload
+(defun gnus-face-from-file (file)
+  "Return an Face header based on an image file."
+  (interactive "fImage file name: ")
+  (when (file-exists-p file)
+    (let ((done nil)
+	  (attempt "")
+	  (step 72)
+	  (quant 16))
+      (while (and (not done)
+		  (> quant 1))
+	(setq attempt
+	      (gnus-shell-command-to-string
+	       (format gnus-convert-image-to-face-command
+		       (shell-quote-argument (expand-file-name file))
+		       quant)))
+	(if (> (length attempt) 740)
+	    (progn
+	      (setq quant (- quant 2))
+	      (message "Length %d; trying quant %d"
+		       (length attempt) quant))
+	  (setq done t)))
+      (if done
+	  (mm-with-unibyte-buffer	
+	    (insert attempt)
+	    (base64-encode-region (point-min) (point-max))
+	    (goto-char (point-min))
+	    (while (search-forward "\n" nil t)
+	      (replace-match ""))
+	    (goto-char (point-min))
+	    (while (> (- (point-max) (point))
+		      step)
+	      (forward-char step)
+	      (insert "\n ")
+	      (setq step 76))
+	    (buffer-string))
+	nil))))
+
+;;;###autoload
+(defun gnus-convert-face-to-png (face)
+  (mm-with-unibyte-buffer
+    (insert face)
+    (ignore-errors
+      (base64-decode-region (point-min) (point-max)))
+    (buffer-string)))
 
 (defun gnus-convert-image-to-gray-x-face (file depth)
   (let* ((mapfile (mm-make-temp-file (expand-file-name "gnus." 
@@ -240,65 +304,6 @@ colors of the displayed X-Faces."
     (gnus-convert-image-to-gray-x-face (concat file ".gif") 3)
     (delete-file (concat file ".gif"))))
 
-(defun gnus-respond-to-confirmation ()
-  "Respond to a Gmane confirmation message."
-  (interactive)
-  (gnus-summary-show-article 'raw)
-  (set-buffer gnus-article-buffer)
-  (let ((buffer-read-only nil))
-    (goto-char (point-min))
-    (gnus-article-goto-header "Original-To")
-    (replace-match "To:"))
-  (let ((auth nil))
-    (when (and (search-forward "Majordomo" nil t)
-	       (re-search-forward "auth.*subscribe.*$" nil t))
-      (setq auth (match-string 0)))
-    (message-wide-reply)
-    (goto-char (point-min))
-    (gnus-article-goto-header "Cc")
-    (replace-match "From:")
-    (message-goto-body)
-    (delete-region (point) (point-max))
-    (when auth
-      (insert auth "\n"))))
-
-(defun gnus-subscribe-to-mailing-list (type)
-  "Generate a Gmane subscription message based on the current gmane.conf line."
-  (interactive
-   (list
-    (intern
-     (completing-read "Mailing list type: "
-		      '(("mailman") ("majordomo") ("exmlm"))
-		      nil t))))
-  (beginning-of-line)
-  (let* ((entry
-	  (split-string
-	   (buffer-substring (point) (progn (end-of-line) (point)))
-	   ":"))
-	 (local (car (split-string (nth 2 entry) "@")))
-	 (host (cadr (split-string (nth 2 entry) "@")))
-	 (from (car entry))
-	 (subject "subscribe")
-	 to)
-    (when (string-match "#" from)
-      (setq from (substring from 1)))
-    (cond
-     ((eq type 'mailman)
-      (setq to (concat local "-request@" host)))
-     ((eq type 'majordomo)
-      (setq to (concat "majordomo@" host)
-	    subject (concat "subscribe " local)))
-     ((eq type 'exmlm)
-      (setq to (concat local "-" from "=m.gmane.org@" host)))
-     (t
-      (error "No such type: %s" type)))
-    (message-mail
-     to subject
-     `((From . ,(concat from "@m.gmane.org"))))
-    (message-goto-body)
-    (delete-region (point) (point-max))
-    (insert subject "\n")))
-  
 (provide 'gnus-fun)
 
 ;;; gnus-fun.el ends here