| 1 | ;;; make-xpms-file.el --- create gnugo.el-support elisp from xpm files |
| 2 | ;;; gnugo.el |
| 3 | ;;; |
| 4 | ;;; This is GNU Go, a Go program. Contact gnugo@gnu.org, or see |
| 5 | ;;; http://www.gnu.org/software/gnugo/ for more information. |
| 6 | ;;; |
| 7 | ;;; Copyright (C) 2003, 2004 by the Free Software Foundation. |
| 8 | ;;; |
| 9 | ;;; This program is free software; you can redistribute it and/ |
| 10 | ;;; modify it under the terms of the GNU General Public License |
| 11 | ;;; as published by the Free Software Foundation - version 3 |
| 12 | ;;; or (at your option) any later version. |
| 13 | ;;; |
| 14 | ;;; This program is distributed in the hope that it will be |
| 15 | ;;; useful, but WITHOUT ANY WARRANTY; without even the implied |
| 16 | ;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR |
| 17 | ;;; PURPOSE. See the GNU General Public License in file COPYING |
| 18 | ;;; for more details. |
| 19 | ;;; |
| 20 | ;;; You should have received a copy of the GNU General Public |
| 21 | ;;; License along with this program; if not, write to the Free |
| 22 | ;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 23 | ;;; Boston, MA 02111, USA. |
| 24 | ;;; |
| 25 | ;;; This Emacs mode for GNU Go may work with Emacs 20.x but |
| 26 | ;;; the graphical display requires Emacs 21.x. |
| 27 | ;;; |
| 28 | ;;; Maintainer: Thien-Thi Nguyen |
| 29 | |
| 30 | ;;; Commentary: |
| 31 | |
| 32 | ;; Usage: EBATCH -l make-xpms-file.el -f make-xpms-file OUTFILE [XPM ...] |
| 33 | ;; where EBATCH is: emacs -batch --no-site-file |
| 34 | ;; |
| 35 | ;; Write to OUTFILE emacs lisp that encapsulates each XPM file. |
| 36 | |
| 37 | ;;; Code: |
| 38 | |
| 39 | (require 'pp) |
| 40 | |
| 41 | (unless (fboundp 'delete-dups) |
| 42 | (defun delete-dups (list) ; from repo 2004-10-29 |
| 43 | "Destructively remove `equal' duplicates from LIST. |
| 44 | Store the result in LIST and return it. LIST must be a proper list. |
| 45 | Of several `equal' occurrences of an element in LIST, the first |
| 46 | one is kept." |
| 47 | (let ((tail list)) |
| 48 | (while tail |
| 49 | (setcdr tail (delete (car tail) (cdr tail))) |
| 50 | (setq tail (cdr tail)))) |
| 51 | list)) |
| 52 | |
| 53 | (defun make-xpms-file-usage () |
| 54 | (message "Usage: %s OUTFILE [XPM ...]" (car (command-line))) |
| 55 | (error "Quit")) |
| 56 | |
| 57 | (defun make-xpms-file-alist-entry (xpm) |
| 58 | (let* ((stem (file-name-sans-extension (file-name-nondirectory xpm))) |
| 59 | (bits (progn (find-file xpm) |
| 60 | (prog1 (buffer-string) |
| 61 | (kill-buffer (current-buffer))))) |
| 62 | (nump (string-match "[0-9]$" stem)) |
| 63 | ;; 1 2 3 |
| 64 | ;; 4 5 6 |
| 65 | ;; 7 8 9 |
| 66 | (key (if (not nump) |
| 67 | (cons (intern stem) 5) |
| 68 | (cons (intern (substring stem 0 -1)) |
| 69 | (string-to-number (substring stem -1)))))) |
| 70 | (cons key bits))) |
| 71 | |
| 72 | (defun make-xpms-file () |
| 73 | (unless noninteractive |
| 74 | (error "Interactive use for make-xpms-file not supported, sorry")) |
| 75 | (let ((outfile (car command-line-args-left)) |
| 76 | (xpms (cdr command-line-args-left)) |
| 77 | entries doc) |
| 78 | (unless (and outfile xpms) |
| 79 | (make-xpms-file-usage)) |
| 80 | (setq entries (mapcar 'make-xpms-file-alist-entry xpms) |
| 81 | doc (concat |
| 82 | "Alist of XPM images suitable for use by gnugo.el.\n" |
| 83 | "Keys are (TYPE . PLACE), where TYPE is one of:\n" |
| 84 | " " (mapconcat 'symbol-name |
| 85 | (delete-dups (mapcar 'caar entries)) |
| 86 | " ") |
| 87 | "\n" |
| 88 | "and PLACE is an integer describing a visible location:\n" |
| 89 | " 1 2 3\n 4 5 6\n 7 8 9.\n" |
| 90 | "The image values are the result of `find-image'.")) |
| 91 | (find-file outfile) |
| 92 | (erase-buffer) |
| 93 | (let ((standard-output (current-buffer))) |
| 94 | (prin1 ";;; generated file --- do not edit!\n |
| 95 | ;;; This is GNU Go, a Go program. Contact gnugo@gnu.org, or see |
| 96 | ;;; http://www.gnu.org/software/gnugo/ for more information. |
| 97 | ;;; |
| 98 | ;;; Copyright (C) 2003, 2004 by the Free Software Foundation. |
| 99 | ;;; |
| 100 | ;;; This program is free software; you can redistribute it and/or |
| 101 | ;;; modify it under the terms of the GNU General Public License |
| 102 | ;;; as published by the Free Software Foundation - version 3 |
| 103 | ;;; or (at your option) any later version. |
| 104 | ;;; |
| 105 | ;;; This program is distributed in the hope that it will be |
| 106 | ;;; useful, but WITHOUT ANY WARRANTY; without even the implied |
| 107 | ;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR |
| 108 | ;;; PURPOSE. See the GNU General Public License in file COPYING |
| 109 | ;;; for more details. |
| 110 | ;;; |
| 111 | ;;; You should have received a copy of the GNU General Public |
| 112 | ;;; License along with this program; if not, write to the Free |
| 113 | ;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 114 | ;;; Boston, MA 02111, USA.\n\n") |
| 115 | (mapc 'pp `((defconst gnugo-xpms |
| 116 | (mapcar (lambda (pair) |
| 117 | (cons (car pair) |
| 118 | (find-image |
| 119 | (list (list :type 'xpm |
| 120 | :data (cdr pair) |
| 121 | :ascent 'center))))) |
| 122 | ',entries) |
| 123 | ,doc) |
| 124 | (provide 'gnugo-xpms)))) |
| 125 | (save-buffer) |
| 126 | (kill-buffer (current-buffer)))) |
| 127 | |
| 128 | |
| 129 | ;;; make-xpms-file.el ends here |