← Back to branch summary

~ubuntu-branches/ubuntu/trusty/librep/trusty

« back to all changes in this revision

Viewing changes to lisp/rep/i18n/xgettext.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2001-11-13 15:06:22 UTC
  • Revision ID: james.westby@ubuntu.com-20011113150622-vgmgmk6srj3kldr3
Tags: upstream-0.15.2
Import upstream version 0.15.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/rep/i18n/xgettext.jl
 
1
#| xgettext.jl -- helper functions for writing xgettext programs
 
2
 
 
3
   $Id: xgettext.jl,v 1.6 2001/01/27 20:16:52 jsh Exp $
 
4
 
 
5
   Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
 
6
 
 
7
   This file is part of librep.
 
8
 
 
9
   librep is free software; you can redistribute it and/or modify it
 
10
   under the terms of the GNU General Public License as published by
 
11
   the Free Software Foundation; either version 2, or (at your option)
 
12
   any later version.
 
13
 
 
14
   librep is distributed in the hope that it will be useful, but
 
15
   WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
   GNU General Public License for more details.
 
18
 
 
19
   You should have received a copy of the GNU General Public License
 
20
   along with librep; see the file COPYING.  If not, write to
 
21
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
|#
 
23
 
 
24
(define-structure rep.i18n.xgettext
 
25
 
 
26
    (export current-file current-module
 
27
            set-included-definers set-helper
 
28
            register scan scan-list scan-file
 
29
            output-c-file output-pot-file)
 
30
 
 
31
    (open rep
 
32
          rep.io.files
 
33
          rep.regexp
 
34
          rep.system)
 
35
 
 
36
  (define current-file (make-fluid))
 
37
  (define current-module (make-fluid))
 
38
 
 
39
  (define found-strings (make-fluid))
 
40
 
 
41
  (define included-definers (make-fluid t))
 
42
  (define helper (make-fluid))
 
43
 
 
44
  (define (set-included-definers lst) (fluid-set included-definers lst))
 
45
  (define (set-helper h) (fluid-set helper h))
 
46
 
 
47
  (define (register string)
 
48
    (let ((cell (assoc string (fluid found-strings))))
 
49
      (if cell
 
50
          (unless (member (fluid current-file) (cdr cell))
 
51
            (rplacd cell (cons (fluid current-file) (cdr cell))))
 
52
        (fluid-set found-strings (cons (list string (fluid current-file))
 
53
                                       (fluid found-strings))))))
 
54
 
 
55
  (define (includedp name)
 
56
    (or (eq (fluid included-definers) t)
 
57
        (memq name (fluid included-definers))))
 
58
 
 
59
  (define (scan form)
 
60
 
 
61
    (if (and (consp form) (eq (car form) '_) (stringp (nth 1 form)))
 
62
        (register (nth 1 form))
 
63
 
 
64
      (when (and (car form) (macrop (car form)))
 
65
        (setq form (macroexpand form)))
 
66
 
 
67
      (when (consp form)
 
68
        (case (car form)
 
69
          ((quote))
 
70
 
 
71
          ((setq setq-default %define)
 
72
           (do ((tem (cdr form) (cddr tem)))
 
73
               ((null (cdr tem)))
 
74
             (scan (cadr tem))))
 
75
 
 
76
          ((let let* letrec let-fluids)
 
77
           (setq form (cdr form))
 
78
           (when (symbolp (car form))
 
79
             (setq form (cdr form)))
 
80
           (let loop ((vars (car form)))
 
81
             (when vars
 
82
               (scan-list (cdar vars))
 
83
               (loop (cdr vars))))
 
84
           (scan-list (cdr form)))
 
85
 
 
86
          ((function) (scan (cdr form)))
 
87
 
 
88
          ((cond)
 
89
           (mapc (lambda (f)
 
90
                   (scan-list f)) (cdr form)))
 
91
 
 
92
          ((lambda) (scan-list (cddr form)))
 
93
 
 
94
          ((defun defmacro defsubst defvar defconst)
 
95
           (when (includedp (car form))
 
96
             (let ((doc (nth 3 form)))
 
97
               (when (stringp doc)
 
98
                 (register doc))))
 
99
           (if (memq (car form) '(defun defmacro defsubst))
 
100
               (scan-list (nthcdr 3 form))
 
101
             (scan-list (nthcdr 2 form))))
 
102
 
 
103
          ((define-structure)
 
104
           (let-fluids ((current-module (nth 1 form)))
 
105
             (scan-list (nthcdr 4 form))))
 
106
 
 
107
          ((structure)
 
108
           (scan-list (nthcdr 3 form)))
 
109
 
 
110
          (t (if (fluid helper)
 
111
                 ((fluid helper) form)
 
112
               (scan-list form)))))))
 
113
 
 
114
  (define (scan-list body)
 
115
    (mapc scan body))
 
116
 
 
117
  (define (scan-file filename)
 
118
    (let ((file (open-file filename 'read)))
 
119
      (when file
 
120
        (unwind-protect
 
121
            (condition-case nil
 
122
                (let-fluids ((current-file filename))
 
123
                  (while t
 
124
                    (let ((form (read file)))
 
125
                      (scan form))))
 
126
              (end-of-stream))
 
127
          (close-file file)))))
 
128
 
 
129
  (defun output-strings (c-mode)
 
130
    (mapc (lambda (x)
 
131
            (let ((string (car x))
 
132
                  (files (cdr x)))
 
133
              (mapc (lambda (f)
 
134
                      (format standard-output "%s %s %s\n"
 
135
                              (if c-mode "  /*" "#:")
 
136
                              f (if c-mode "*/" ""))) files)
 
137
            (let* ((print-escape 'newlines)
 
138
                   (out (format nil "%S" string))
 
139
                   (point 0))
 
140
              (if c-mode
 
141
                  (format standard-output "  _(%s);\n\n" out)
 
142
                (while (and (< point (length out))
 
143
                            (string-match "\\\\n" out point))
 
144
                  (setq out (concat (substring out 0 (match-start)) "\\n\"\n\""
 
145
                                    (substring out (match-end))))
 
146
                  (setq point (+ (match-end) 3)))
 
147
                (format standard-output "msgid %s\nmsgstr \"\"\n\n" out)))))
 
148
        (nreverse (fluid found-strings))))
 
149
 
 
150
  (define (output-c-file)
 
151
    (write standard-output "\
 
152
/* SOME DESCRIPTIVE TITLE */
 
153
/* This file is intended to be parsed by xgettext.
 
154
 * It is not intended to be compiled.
 
155
 */
 
156
 
 
157
#if 0
 
158
void some_function_name() {\n\n")
 
159
    (output-strings t)
 
160
    (write standard-output "\
 
161
}
 
162
#endif\n"))
 
163
 
 
164
  (define (output-pot-file)
 
165
    (format standard-output "\
 
166
# SOME DESCRIPTIVE TITLE.
 
167
# Copyright (C) YEAR Free Software Foundation, Inc.
 
168
# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
 
169
#
 
170
#, fuzzy
 
171
msgid \"\"
 
172
msgstr \"\"
 
173
\"Project-Id-Version: PACKAGE VERSION\\n\"
 
174
\"POT-Creation-Date: %s\\n\"
 
175
\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\"
 
176
\"Last-Translator: FULL NAME <EMAIL@ADDRESS>\\n\"
 
177
\"Language-Team: LANGUAGE <LL@li.org>\\n\"
 
178
\"MIME-Version: 1.0\\n\"
 
179
\"Content-Type: text/plain; charset=CHARSET\\n\"
 
180
\"Content-Transfer-Encoding: ENCODING\\n\"\n\n"
 
181
          (current-time-string nil "%Y-%m-%d %H:%M%z"))
 
182
    (output-strings nil)))