Commit | Line | Data |
---|---|---|
7eeb782e AT |
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 |