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