cgit.sxemacs.org Git - gnus/blob - contrib/compface.el

   1 ;;; compface.el --- functions for converting X-Face headers
   2 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;;      TAKAI Kousuke <tak@kmc.gr.jp>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (defgroup compface nil
  30   "X-Face image conversion."
  31   :group 'extensions)
  32
  33 (defcustom uncompface-use-external (and (not noninteractive)
  34                                         (executable-find "uncompface")
  35                                         (executable-find "icontopbm")
  36                                         'undecided)
  37   "*Specify which of the internal or the external decoder should be used.
  38 nil means to use the internal ELisp-based uncompface program.  t means
  39 to use the external decoder.  In the later case, you need to have the
  40 external `uncompface' and `icontopbm' programs installed.  The default
  41 value is nil if those external programs aren't available, otherwise
  42 `undecided' which means to determine it by checking whether the host
  43 machine is slow.  See also `uncompface-use-external-threshold'.  You
  44 can skip that check by setting this value as nil or t explicitly."
  45   :type '(choice (const :tag "Use the internal decoder" nil)
  46                  (const :tag "Use the external decoder" t)
  47                  (const :tag "Autodetection" undecided))
  48   :group 'compface)
  49
  50 (defcustom uncompface-use-external-threshold 0.1
  51   "*Number of seconds to check whether the host machine is slow.
  52 If the host takes time larger than this value for decoding an X-Face
  53 using the internal ELisp-based uncompface program, it will be changed
  54 to using the external `uncompface' and `icontopbm' programs if they
  55 are available.  Note that the measurement may never be exact."
  56   :type 'number
  57   :group 'compface)
  58
  59 (eval-when-compile
  60   (defmacro uncompface-float-time (&optional specified-time)
  61     (if (fboundp 'float-time)
  62         `(float-time ,specified-time)
  63       `(let ((time (or ,specified-time (current-time))))
  64          (+ (* (car time) 65536.0)
  65             (cadr time)
  66             (cond ((consp (setq time (cddr time)))
  67                    (/ (car time) 1000000.0))
  68                   (time
  69                    (/ time 1000000.0))
  70                   (t
  71                    0)))))))
  72
  73 (defun uncompface (face)
  74   "Convert FACE to pbm.
  75 If `uncompface-use-external' is t, it requires the external programs
  76 `uncompface', and `icontopbm'.  On a GNU/Linux system these might be
  77 in packages with names like `compface' or `faces-xface' and `netpbm'
  78 or `libgr-progs', for instance."
  79   (cond ((eq uncompface-use-external nil)
  80          (uncompface-internal face))
  81         ((eq uncompface-use-external t)
  82          (with-temp-buffer
  83            (unless (featurep 'xemacs) (set-buffer-multibyte nil))
  84            (insert face)
  85            (let ((coding-system-for-read 'raw-text)
  86                  ;; At least "icontopbm" doesn't work with Windows because
  87                  ;; the line-break code is converted into CRLF by default.
  88                  (coding-system-for-write 'binary))
  89              (and (eq 0 (apply 'call-process-region (point-min) (point-max)
  90                                "uncompface"
  91                                'delete '(t nil) nil))
  92                   (progn
  93                     (goto-char (point-min))
  94                     (insert "/* Width=48, Height=48 */\n")
  95                     ;; I just can't get "icontopbm" to work correctly on its
  96                     ;; own in XEmacs.  And Emacs doesn't understand un-raw pbm
  97                     ;; files.
  98                     (if (not (featurep 'xemacs))
  99                         (eq 0 (call-process-region (point-min) (point-max)
 100                                                    "icontopbm"
 101                                                    'delete '(t nil)))
 102                       (shell-command-on-region (point-min) (point-max)
 103                                                "icontopbm | pnmnoraw"
 104                                                (current-buffer) t)
 105                       t))
 106                   (buffer-string)))))
 107         (t
 108          (let* ((gc-cons-threshold (eval '(lsh -1 -1)))
 109                 (start (current-time)))
 110            (prog1
 111                (uncompface-internal face)
 112              (setq uncompface-use-external
 113                    (and (> (- (uncompface-float-time (current-time))
 114                               (uncompface-float-time start))
 115                            uncompface-use-external-threshold)
 116                         (executable-find "uncompface")
 117                         (executable-find "icontopbm")
 118                         t))
 119              (message "Setting `uncompface-use-external' to `%s'"
 120                       uncompface-use-external))))))
 121
 122 ;; The following section is a bug-for-bug compatible version of
 123 ;; `uncompface' program entirely implemented in Emacs-Lisp.
 124
 125 (eval-when-compile
 126   ;; The size of 48x48 is actually hard-coded into the code itself,
 127   ;; so you cannot simply change those values.  So we hard-code
 128   ;; them into the compiled code.
 129   (defconst uncompface-width 48
 130     "Width of X-Face bitmap image.")
 131   (defconst uncompface-height 48
 132     "Height of X-Face bitmap image.")
 133
 134   ;; Again, this is also hard-coded into the compiled code.
 135   (defconst uncompface-guesses
 136     (mapcar (lambda (x)
 137               (mapcar (lambda (x)
 138                         (let ((vector (make-vector (length x) nil))
 139                               (i 0))
 140                           (while x
 141                             (or (zerop (car x))
 142                                 (aset vector i t))
 143                             (setq x (cdr x)
 144                                   i (1+ i)))
 145                           vector))
 146                       x))
 147             '((;; g_00
 148                (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 149                 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1
 150                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 151                 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1
 152                 0 0 0 0 0 1 0 1 0 0 0 1 0 1 1 1
 153                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
 154                 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1
 155                 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1
 156                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
 157                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 158                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
 159                 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1
 160                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 161                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
 162                 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 1
 163                 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 1
 164                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 165                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1
 166                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0
 167                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 168                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
 169                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
 170                 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1
 171                 1 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
 172                 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1
 173                 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1
 174                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
 175                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 176                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 177                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 178                 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1
 179                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 180                 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0
 181                 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 1
 182                 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1
 183                 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1
 184                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 185                 0 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1
 186                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 187                 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1
 188                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
 189                 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1
 190                 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1
 191                 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1
 192                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 193                 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1
 194                 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
 195                 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1
 196                 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1
 197                 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1
 198                 0 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1
 199                 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1
 200                 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 201                 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 1
 202                 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
 203                 1 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1
 204                 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1
 205                 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1
 206                 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1
 207                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 208                 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 1
 209                 0 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1
 210                 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 1
 211                 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
 212                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 213                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
 214                 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1
 215                 0 0 0 0 0 0 0 1 1 1 0 1 1 1 1 1
 216                 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0
 217                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
 218                 0 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0
 219                 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1
 220                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 221                 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 222                 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1
 223                 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 1
 224                 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1
 225                 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1
 226                 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 1
 227                 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1
 228                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
 229                 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
 230                 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1
 231                 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1
 232                 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 1
 233                 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1
 234                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
 235                 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1
 236                 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1
 237                 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0
 238                 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
 239                 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0
 240                 0 0 0 0 0 1 0 1 0 0 0 0 0 1 0 0
 241                 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1
 242                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
 243                 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1
 244                 0 1 0 0 1 0 1 0 0 1 0 0 0 0 0 0
 245                 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1
 246                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0
 247                 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1
 248                 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1
 249                 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1
 250                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 251                 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1
 252                 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1
 253                 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1
 254                 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1
 255                 0 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
 256                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 257                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 258                 1 1 1 1 1 1 1 1 0 1 1 1 0 1 1 1
 259                 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1
 260                 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1
 261                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 262                 0 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1
 263                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 264                 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
 265                 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1
 266                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 267                 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1
 268                 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1
 269                 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
 270                 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1
 271                 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 272                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
 273                 1 1 0 0 1 1 0 1 0 0 0 0 1 1 1 1
 274                 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1
 275           &nbs