File: encode-all.el

package info (click to toggle)
libx11-protocol-other-perl 28-1%2Bdeb8u1
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 1,692 kB
  • ctags: 556
  • sloc: perl: 17,055; ansic: 624; sh: 238; lisp: 143; makefile: 39
file content (113 lines) | stat: -rw-r--r-- 3,742 bytes parent folder | download | duplicates (5)
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
;; Copyright 2011 Kevin Ryde
;;
;; This file is part of X11-Protocol-Other.
;;
;; X11-Protocol-Other 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; either version 3, or (at your option) any
;; later version.
;;
;; X11-Protocol-Other 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 for more details.
;;
;; You should have received a copy of the GNU General Public License along
;; with X11-Protocol-Other.  If not, see <http://www.gnu.org/licenses/>.


;; ctext-non-standard-encodings
;; ctext-non-standard-encodings-alist

(defun my-ctext ()
  (my-ctext-1 'ctext "")
  (when (coding-system-p 'compound-text-with-extensions)
    (my-ctext-1 'compound-text-with-extensions "-ext")))

(defun my-ctext-1 (coding ext)
  (unless (coding-system-p 'utf-8)
    (require 'un-define))

  (let ((ctext-non-standard-encodings-alist nil)
        (ctext-non-standard-encodings nil))

    (with-temp-buffer
      (dotimes (i #x2FA1D)
        (unless (or (< i 32)
                    (and (>= i #x7F) (<= i #x9F))
                    (and (>= i #xD800) (<= i #xDFFF))
                    (and (>= i #xFDD0) (<= i #xFDEF))
                    (and (>= i #xFFFE) (<= i #xFFFF))
                    (and (>= i #x1FFFE) (<= i #x1FFFF)))
          (let ((c (decode-char 'ucs i)))
            (if c
                (if (encode-coding-char c coding)
                    (insert c))))))

      (let ((str (buffer-string))
            (basename (format "encode-%s%d"
                              (if (featurep 'xemacs) "xemacs" "emacs")
                              emacs-major-version))
            (backup-inhibited t))

        (find-file (format "%s%s.ctext" basename ext))
        (erase-buffer)
        (insert str)
        (set-buffer-file-coding-system coding)
        (save-buffer)
        (kill-buffer nil)

        (find-file (format "%s%s.utf8" basename ext))
        (erase-buffer)
        (insert str)
        (set-buffer-file-coding-system 'utf-8)
        (save-buffer)
        (kill-buffer nil)))))







      ;;   (find-file (format "encode-%s%d-ext.ctext"
      ;;                      (if (featurep 'xemacs) "xemacs" "emacs")
      ;;                      emacs-major-version))
      ;;   (erase-buffer)
      ;;   (insert str)
      ;;   (set-buffer-file-coding-system 'ctext)
      ;;   (save-buffer)
      ;;   (kill-buffer nil))))



      ;; (let ((want-len 192954)
      ;;       (got-len (length str)))
      ;;   (unless (= want-len got-len)
      ;;     (error "want-len %S got-len %S" want-len got-len)))


    ;; (let ((coding-system-for-read 'utf-8))
    ;;   (find-file "encode-all.utf8"))
    ;; (message "coding used %S" last-coding-system-used)
    ;; (message "buffer coding %S" buffer-file-coding-system)

;;    (let ((coding-system-for-write )
;;          (write-file ))
;; 
;;        (let ((coding-system-for-write 'compound-text-with-extensions)
;;              (backup-inhibited t))
;;          (write-file (format "encode-%s%d-ext.ctext"
;;                              (if (featurep 'xemacs) "xemacs" "emacs")
;;                              emacs-major-version))))))
;; 
;; 
;; ;; (dotimes (i #x2FA1)
;; ;;   (unless (or (< i 32)
;; ;;               (and (>= i #x80) (<= i #x9F))
;; ;;               (and (>= i #xD800) (<= i #xDFFF))
;; ;;               (and (>= i #xFDD0) (<= i #xFDEF))
;; ;;               (and (>= i #xFFFE) (<= i #xFFFF))
;; ;;               (and (>= i #x1FFFE) (<= i #x1FFFF)))
;; ;;     (insert (decode-char 'ucs i))))