annotate lisp/gnus/gnus-fun.el @ 88286:32c6e924fc14

*** empty log message ***
author Alex Schroeder <alex@gnu.org>
date Mon, 23 Jan 2006 16:54:26 +0000
parents d7ddb3e565de
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
88155
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
1 ;;; gnus-fun.el --- various frivolous extension functions to Gnus
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
2
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
4
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
6 ;; Keywords: news
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
7
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
9
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
13 ;; any later version.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
14
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
18 ;; GNU General Public License for more details.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
19
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
23 ;; Boston, MA 02110-1301, USA.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
24
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
25 ;;; Commentary:
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
26
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
27 ;;; Code:
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
28
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
29 (eval-when-compile
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
30 (require 'cl))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
31
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
32 (require 'mm-util)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
33 (require 'gnus-ems)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
34 (require 'gnus-util)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
35
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
36 (defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
37 "*Directory where X-Face PBM files are stored."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
38 :version "22.1"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
39 :group 'gnus-fun
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
40 :type 'directory)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
41
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
42 (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
43 "Command for converting a PBM to an X-Face."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
44 :version "22.1"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
45 :group 'gnus-fun
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
46 :type 'string)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
47
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
48 (defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
49 "Command for converting an image to an X-Face.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
50 By default it takes a GIF filename and output the X-Face header data
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
51 on stdout."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
52 :version "22.1"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
53 :group 'gnus-fun
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
54 :type 'string)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
55
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
56 (defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
57 "Command for converting an image to a Face.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
58 By default it takes a JPEG filename and output the Face header data
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
59 on stdout."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
60 :version "22.1"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
61 :group 'gnus-fun
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
62 :type 'string)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
63
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
64 (defun gnus-shell-command-to-string (command)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
65 "Like `shell-command-to-string' except not mingling ERROR."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
66 (with-output-to-string
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
67 (call-process shell-file-name nil (list standard-output nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
68 nil shell-command-switch command)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
69
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
70 (defun gnus-shell-command-on-region (start end command)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
71 "A simplified `shell-command-on-region'.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
72 Output to the current buffer, replace text, and don't mingle error."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
73 (call-process-region start end shell-file-name t
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
74 (list (current-buffer) nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
75 nil shell-command-switch command))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
76
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
77 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
78 (defun gnus-random-x-face ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
79 "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
80 (interactive)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
81 (when (file-exists-p gnus-x-face-directory)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
82 (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
83 (file (nth (random (length files)) files)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
84 (when file
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
85 (gnus-shell-command-to-string
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
86 (format gnus-convert-pbm-to-x-face-command
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
87 (shell-quote-argument file)))))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
88
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
89 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
90 (defun gnus-insert-random-x-face-header ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
91 "Insert a random X-Face header from `gnus-x-face-directory'."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
92 (interactive)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
93 (let ((data (gnus-random-x-face)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
94 (save-excursion
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
95 (message-goto-eoh)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
96 (if data
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
97 (insert "X-Face: " data)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
98 (message
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
99 "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
100 gnus-x-face-directory)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
101
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
102 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
103 (defun gnus-x-face-from-file (file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
104 "Insert an X-Face header based on an image file."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
105 (interactive "fImage file name (by default GIF): ")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
106 (when (file-exists-p file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
107 (gnus-shell-command-to-string
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
108 (format gnus-convert-image-to-x-face-command
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
109 (shell-quote-argument (expand-file-name file))))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
110
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
111 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
112 (defun gnus-face-from-file (file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
113 "Return a Face header based on an image file."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
114 (interactive "fImage file name (by default JPEG): ")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
115 (when (file-exists-p file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
116 (let ((done nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
117 (attempt "")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
118 (quant 16))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
119 (while (and (not done)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
120 (> quant 1))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
121 (setq attempt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
122 (let ((coding-system-for-read 'binary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
123 (gnus-shell-command-to-string
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
124 (format gnus-convert-image-to-face-command
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
125 (shell-quote-argument (expand-file-name file))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
126 quant))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
127 (if (> (length attempt) 726)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
128 (progn
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
129 (setq quant (- quant 2))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
130 (gnus-message 9 "Length %d; trying quant %d"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
131 (length attempt) quant))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
132 (setq done t)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
133 (if done
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
134 (mm-with-unibyte-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
135 (insert attempt)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
136 (gnus-face-encode))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
137 nil))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
138
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
139 (defun gnus-face-encode ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
140 (let ((step 72))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
141 (base64-encode-region (point-min) (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
142 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
143 (while (search-forward "\n" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
144 (replace-match ""))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
145 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
146 (while (> (- (point-max) (point))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
147 step)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
148 (forward-char step)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
149 (insert "\n ")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
150 (setq step 76))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
151 (buffer-string)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
152
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
153 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
154 (defun gnus-convert-face-to-png (face)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
155 "Convert FACE (which is base64-encoded) to a PNG.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
156 The PNG is returned as a string."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
157 (mm-with-unibyte-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
158 (insert face)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
159 (ignore-errors
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
160 (base64-decode-region (point-min) (point-max)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
161 (buffer-string)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
162
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
163 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
164 (defun gnus-convert-png-to-face (file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
165 "Convert FILE to a Face.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
166 FILE should be a PNG file that's 48x48 and smaller than or equal to
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
167 726 bytes."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
168 (mm-with-unibyte-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
169 (insert-file-contents file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
170 (when (> (buffer-size) 726)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
171 (error "The file is %d bytes long, which is too long"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
172 (buffer-size)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
173 (gnus-face-encode)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
174
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
175 (defface gnus-x-face '((t (:foreground "black" :background "white")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
176 "Face to show X-Face.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
177 The colors from this face are used as the foreground and background
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
178 colors of the displayed X-Faces."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
179 :group 'gnus-article-headers)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
180
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
181 (defun gnus-display-x-face-in-from (data)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
182 "Display the X-Face DATA in the From header."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
183 (let ((default-enable-multibyte-characters nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
184 pbm)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
185 (when (or (gnus-image-type-available-p 'xface)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
186 (and (gnus-image-type-available-p 'pbm)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
187 (setq pbm (uncompface data))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
188 (save-excursion
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
189 (save-restriction
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
190 (article-narrow-to-head)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
191 (gnus-article-goto-header "from")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
192 (when (bobp)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
193 (insert "From: [no `from' set]\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
194 (forward-char -17))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
195 (gnus-add-image
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
196 'xface
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
197 (gnus-put-image
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
198 (if (gnus-image-type-available-p 'xface)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
199 (gnus-create-image
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
200 (concat "X-Face: " data)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
201 'xface t :face 'gnus-x-face)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
202 (gnus-create-image
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
203 pbm 'pbm t :face 'gnus-x-face)) nil 'xface))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
204 (gnus-add-wash-type 'xface))))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
205
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
206 (defun gnus-grab-cam-x-face ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
207 "Grab a picture off the camera and make it into an X-Face."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
208 (interactive)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
209 (shell-command "xawtv-remote snap ppm")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
210 (let ((file nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
211 (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
212 t "snap.*ppm")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
213 (sleep-for 1))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
214 (setq file (car file))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
215 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
216 (shell-command
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
217 (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
218 file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
219 (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
220 ;;(sleep-for 3)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
221 (delete-file file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
222 (buffer-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
223
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
224 (defun gnus-grab-cam-face ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
225 "Grab a picture off the camera and make it into an X-Face."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
226 (interactive)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
227 (shell-command "xawtv-remote snap ppm")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
228 (let ((file nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
229 result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
230 (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
231 t "snap.*ppm")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
232 (sleep-for 1))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
233 (setq file (car file))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
234 (shell-command
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
235 (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > /tmp/gnus.face.ppm"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
236 file))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
237 (let ((gnus-convert-image-to-face-command
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
238 (format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
239 (gnus-fun-ppm-change-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
240 (setq result (gnus-face-from-file "/tmp/gnus.face.ppm")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
241 (delete-file file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
242 ;;(delete-file "/tmp/gnus.face.ppm")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
243 result))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
244
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
245 (defun gnus-fun-ppm-change-string ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
246 (let* ((possibilites '("%02x0000" "00%02x00" "0000%02x"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
247 "%02x%02x00" "00%02x%02x" "%02x00%02x"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
248 (format (concat "'#%02x%02x%02x' '#"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
249 (nth (random 6) possibilites)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
250 "'"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
251 (values nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
252 (dotimes (i 255)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
253 (push (format format i i i i i i)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
254 values))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
255 (mapconcat 'identity values " ")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
256
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
257 (provide 'gnus-fun)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
258
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
259 ;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
260 ;;; gnus-fun.el ends here