← Back to branch summary

~ubuntu-branches/ubuntu/utopic/gettext/utopic

« back to all changes in this revision

Viewing changes to gettext-tools/misc/po-compat.el

  • Committer: Colin Watson
  • Date: 2010-08-01 21:36:08 UTC
  • mfrom: (2.1.10 sid)
  • Revision ID: cjwatson@canonical.com-20100801213608-yy7vkm8lpatep3ci
merge from Debian 0.18.1.1-1

Show diffs side-by-side

added added

removed removed

Lines of Context:
gettext-tools/misc/po-compat.el
44
44
;;   - GNU Emacs (version 19) -> no flag.
45
45
(eval-and-compile
46
46
  (cond ((string-match "XEmacs\\|Lucid" emacs-version)
47
 
         (setq po-EMACS20 nil po-XEMACS t))
48
 
        ((and (string-lessp "19" emacs-version) (featurep 'faces))
49
 
         (setq po-EMACS20 t po-XEMACS nil))
50
 
        (t (setq po-EMACS20 nil po-XEMACS nil))))
 
47
         (setq po-EMACS20 nil po-XEMACS t))
 
48
        ((and (string-lessp "19" emacs-version) (featurep 'faces))
 
49
         (setq po-EMACS20 t po-XEMACS nil))
 
50
        (t (setq po-EMACS20 nil po-XEMACS nil))))
51
51
 
52
52
;; Handle missing 'with-temp-buffer' function.
53
53
(eval-and-compile
57
57
    (defmacro po-with-temp-buffer (&rest forms)
58
58
      "Create a temporary buffer, and evaluate FORMS there like 'progn'."
59
59
      (let ((curr-buffer (make-symbol "curr-buffer"))
60
 
            (temp-buffer (make-symbol "temp-buffer")))
61
 
        `(let ((,curr-buffer (current-buffer))
62
 
               (,temp-buffer (get-buffer-create
63
 
                              (generate-new-buffer-name " *po-temp*"))))
64
 
           (unwind-protect
65
 
               (progn
66
 
                 (set-buffer ,temp-buffer)
67
 
                 ,@forms)
68
 
             (set-buffer ,curr-buffer)
69
 
             (and (buffer-name ,temp-buffer)
70
 
                  (kill-buffer ,temp-buffer))))))))
 
60
            (temp-buffer (make-symbol "temp-buffer")))
 
61
        `(let ((,curr-buffer (current-buffer))
 
62
               (,temp-buffer (get-buffer-create
 
63
                              (generate-new-buffer-name " *po-temp*"))))
 
64
           (unwind-protect
 
65
               (progn
 
66
                 (set-buffer ,temp-buffer)
 
67
                 ,@forms)
 
68
             (set-buffer ,curr-buffer)
 
69
             (and (buffer-name ,temp-buffer)
 
70
                  (kill-buffer ,temp-buffer))))))))
71
71
 
72
72
(defconst po-content-type-charset-alist
73
73
  '(; Note: Emacs 21 doesn't support all encodings, thus the missing entries.
154
154
  "Return PO file charset value."
155
155
  (interactive)
156
156
  (let ((charset-regexp
157
 
         "^\"Content-Type: text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
158
 
        (short-read nil))
 
157
         "^\"Content-Type: text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
 
158
        (short-read nil))
159
159
    ;; Try the first 4096 bytes.  In case we cannot find the charset value
160
160
    ;; within the first 4096 bytes (the PO file might start with a long
161
161
    ;; comment) try the next 4096 bytes repeatedly until we'll know for sure
163
163
    (while (not (or short-read (re-search-forward "^msgid" nil t)))
164
164
      (save-excursion
165
165
        (goto-char (point-max))
166
 
        (let ((pair (insert-file-contents-literally filename nil
167
 
                                                    (1- (point))
168
 
                                                    (1- (+ (point) 4096)))))
169
 
          (setq short-read (< (nth 1 pair) 4096)))))
 
166
        (let ((pair (insert-file-contents-literally filename nil
 
167
                                                    (1- (point))
 
168
                                                    (1- (+ (point) 4096)))))
 
169
          (setq short-read (< (nth 1 pair) 4096)))))
170
170
    (cond ((re-search-forward charset-regexp nil t) (match-string 1))
171
 
          (short-read nil)
172
 
          ;; We've found the first msgid; maybe, only a part of the msgstr
173
 
          ;; value was loaded.  Load the next 1024 bytes; if charset still
174
 
          ;; isn't available, give up.
175
 
          (t (save-excursion
176
 
               (goto-char (point-max))
177
 
               (insert-file-contents-literally filename nil
178
 
                                               (1- (point))
179
 
                                               (1- (+ (point) 1024))))
180
 
             (if (re-search-forward charset-regexp nil t)
181
 
                 (match-string 1))))))
 
171
          (short-read nil)
 
172
          ;; We've found the first msgid; maybe, only a part of the msgstr
 
173
          ;; value was loaded.  Load the next 1024 bytes; if charset still
 
174
          ;; isn't available, give up.
 
175
          (t (save-excursion
 
176
               (goto-char (point-max))
 
177
               (insert-file-contents-literally filename nil
 
178
                                               (1- (point))
 
179
                                               (1- (+ (point) 1024))))
 
180
             (if (re-search-forward charset-regexp nil t)
 
181
                 (match-string 1))))))
182
182
 
183
183
(eval-and-compile
184
184
  (if po-EMACS20
185
185
      (defun po-find-file-coding-system-guts (operation filename)
186
 
        "\
 
186
        "\
187
187
Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
188
188
Called through file-coding-system-alist, before the file is visited for real."
189
 
        (and (eq operation 'insert-file-contents)
190
 
             (file-exists-p filename)
191
 
             (po-with-temp-buffer
192
 
              (let* ((coding-system-for-read 'no-conversion)
193
 
                     (charset (or (po-find-charset filename) "ascii"))
194
 
                     (charset-upper (upcase charset))
195
 
                     (charset-lower (downcase charset))
196
 
                     (candidate
197
 
                      (cdr (assoc charset-upper po-content-type-charset-alist)))
198
 
                     (try-symbol (or candidate (intern-soft charset-lower)))
199
 
                     (try-string
200
 
                      (if try-symbol (symbol-name try-symbol) charset-lower)))
201
 
                (list (cond ((and try-symbol (coding-system-p try-symbol))
202
 
                             try-symbol)
203
 
                            ((and po-EMACS20
204
 
                                  (string-match "\\`cp[1-9][0-9][0-9]?\\'"
205
 
                                                try-string)
206
 
                                  (assoc (substring try-string 2)
207
 
                                         (cp-supported-codepages)))
208
 
                             (codepage-setup (substring try-string 2))
209
 
                             (intern try-string))
210
 
                            (t
211
 
                             'no-conversion))))))))
 
189
        (and (eq operation 'insert-file-contents)
 
190
             (file-exists-p filename)
 
191
             (po-with-temp-buffer
 
192
              (let* ((coding-system-for-read 'no-conversion)
 
193
                     (charset (or (po-find-charset filename) "ascii"))
 
194
                     (charset-upper (upcase charset))
 
195
                     (charset-lower (downcase charset))
 
196
                     (candidate
 
197
                      (cdr (assoc charset-upper po-content-type-charset-alist)))
 
198
                     (try-symbol (or candidate (intern-soft charset-lower)))
 
199
                     (try-string
 
200
                      (if try-symbol (symbol-name try-symbol) charset-lower)))
 
201
                (list (cond ((and try-symbol (coding-system-p try-symbol))
 
202
                             try-symbol)
 
203
                            ((and po-EMACS20
 
204
                                  (string-match "\\`cp[1-9][0-9][0-9]?\\'"
 
205
                                                try-string)
 
206
                                  (assoc (substring try-string 2)
 
207
                                         (cp-supported-codepages)))
 
208
                             (codepage-setup (substring try-string 2))
 
209
                             (intern try-string))
 
210
                            (t
 
211
                             'no-conversion))))))))
212
212
 
213
213
  (if po-XEMACS
214
214
      (defun po-find-file-coding-system-guts (operation filename)
215
 
        "\
 
215
        "\
216
216
Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
217
217
Called through file-coding-system-alist, before the file is visited for real."
218
 
        (and (eq operation 'insert-file-contents)
219
 
             (file-exists-p filename)
220
 
             (po-with-temp-buffer
221
 
               (let ((coding-system-for-read 'no-conversion))
 
218
        (and (eq operation 'insert-file-contents)
 
219
             (file-exists-p filename)
 
220
             (po-with-temp-buffer
 
221
               (let ((coding-system-for-read 'no-conversion))
222
222
                 (let* ((charset (or (po-find-charset filename)
223
 
                                     "ascii"))
 
223
                                     "ascii"))
224
224
                        (charset-upper (upcase charset))
225
225
                        (charset-lower (intern (downcase charset))))
226
226
                   (list (or (cdr (assoc charset-upper
231
231
 
232
232
  (if po-EMACS20
233
233
      (defun po-find-file-coding-system (arg-list)
234
 
        "\
 
234
        "\
235
235
Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
236
236
Called through file-coding-system-alist, before the file is visited for real."
237
 
        (po-find-file-coding-system-guts (car arg-list) (car (cdr arg-list)))))
 
237
        (po-find-file-coding-system-guts (car arg-list) (car (cdr arg-list)))))
238
238
 
239
239
  (if po-XEMACS
240
240
      (defun po-find-file-coding-system (operation filename)
241
 
        "\
 
241
        "\
242
242
Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
243
243
Called through file-coding-system-alist, before the file is visited for real."
244
 
        (po-find-file-coding-system-guts operation filename)))
 
244
        (po-find-file-coding-system-guts operation filename)))
245
245
 
246
246
  )
247
247