diff --git a/skk-develop.el b/skk-develop.el index c9040606..7f65c430 100644 --- a/skk-develop.el +++ b/skk-develop.el @@ -27,46 +27,55 @@ ;;; Code: (require 'skk) -(require 'tar-util) (eval-when-compile (require 'url) (defvar skk-exserv-list)) -(defvar skk-get-files '("SKK-JISYO.JIS2.gz" - "SKK-JISYO.JIS2004.gz" - "SKK-JISYO.JIS3_4.gz" - "SKK-JISYO.L.gz" - "SKK-JISYO.assoc.gz" - "SKK-JISYO.edict.tar.gz" - "SKK-JISYO.fullname.gz" - "SKK-JISYO.geo.gz" - "SKK-JISYO.itaiji.gz" - "SKK-JISYO.jinmei.gz" - "SKK-JISYO.law.gz" - "SKK-JISYO.lisp.gz" - "SKK-JISYO.mazegaki.gz" - "SKK-JISYO.okinawa.gz" - "SKK-JISYO.propernoun.gz" - "SKK-JISYO.pubdic+.gz" - "SKK-JISYO.station.gz" - "zipcode.tar.gz") - "") +(defvar skk-dict-collection + '(("SKK-JISYO.L.gz" . euc-jp-unix) + ("SKK-JISYO.JIS2.gz" . euc-jp-unix) + ("SKK-JISYO.JIS2004.gz" . euc-jisx0213-unix) + ("SKK-JISYO.JIS3_4.gz" . euc-jisx0213-unix) + ("SKK-JISYO.assoc.gz" . euc-jp-unix) + ("SKK-JISYO.edict.tar.gz" . archive) + ("SKK-JISYO.fullname.gz" . euc-jisx0213-unix) + ("SKK-JISYO.geo.gz" . euc-jp-unix) + ("SKK-JISYO.itaiji.gz" . euc-jp-unix) + ("SKK-JISYO.jinmei.gz" . euc-jp-unix) + ("SKK-JISYO.law.gz" . euc-jp-unix) + ("SKK-JISYO.lisp.gz" . euc-jp-unix) + ("SKK-JISYO.mazegaki.gz" . euc-jp-unix) + ("SKK-JISYO.okinawa.gz" . euc-jp-unix) + ("SKK-JISYO.propernoun.gz" . euc-jp-unix) + ("SKK-JISYO.pubdic+.gz" . euc-jp-unix) + ("SKK-JISYO.station.gz" . euc-jp-unix) + ("zipcode.tar.gz" . archive)) + "SKK $B<-=q$N%j%9%H!#(B +$BCM$,(B 'archive $B$J$i(B tar $B$GE83+!#(B +$B$=$l0J30$N%7%s%\%k$J$i!"$=$NJ8;z%3!<%I$GC10l%U%!%$%k$rE83+!#(B") + +;; TODO: +;; SKK-JISYO.office.zipcode . euc-jisx0213-unix +;; SKK-JISYO.zipcode . euc-jisx0213-unix (defun skk-get-delete-files (dir) - "DIR." - (let ((files (cons "edict_doc.txt" skk-get-files)) - p) - (dolist (filename files) - (dolist (file (list filename - (replace-regexp-in-string ".gz" "" filename) - (replace-regexp-in-string ".tar.gz" "" filename))) - (setq p (expand-file-name file dir)) - (when (file-exists-p p) - (cond ((null (car (file-attributes p))) - (delete-file p)) - (t - (delete-directory p t)))))))) + "DIR $BFb$N<-=q%U%!%$%k!J%"!<%+%$%V!"C10l%U%!%$%k!"%G%#%l%/%H%j!K$r0lA]$9$k!#(B" + (pcase-dolist (`(,f . ,_conf) skk-dict-collection) + (let ((targets (list f ; $B85$N(B .gz / .tar.gz + (replace-regexp-in-string "\\.tar\\.gz\\'" "" f) ; $BE83+8e(B(tar) + (replace-regexp-in-string "\\.gz\\'" "" f)))) ; $BE83+8e(B(gz) + + ;; SKK-JISYO.edict.tar.gz $B$KIU?o$9$kFC]$K2C$($k(B + (when (string= f "SKK-JISYO.edict.tar.gz") + (push "edict_doc.txt" targets)) + + (dolist (file targets) + (let ((path (expand-file-name file dir))) + (when (file-exists-p path) + (if (file-directory-p path) + (delete-directory path t) + (delete-file path)))))))) (defun skk-get-mkdir (dir) "DIR." @@ -75,28 +84,43 @@ (make-directory dir t))) (defun skk-get-download (dir) - "DIR." - (let ((url "https://skk-dev.github.io/dict/") - fn) - (dolist (f skk-get-files) - (setq fn (expand-file-name f dir)) - (unless (file-exists-p fn) - (url-copy-file (format "%s%s" url f) fn))))) - -(defun skk-get-expand-tar (dir) - "DIR." - ;; (let (fn) - ;; (dolist (f (directory-files dir t "tar")) - ;; (setq fn (convert-standard-filename f)) - ;; (shell-command (format "tar -xf %s -C %s && rm %s" - ;; fn dir fn)))) - (let ((list '(("SKK-JISYO.edict.tar" . "SKK-JISYO.edict") - ("zipcode.tar" . "SKK-JISYO.zipcode") - ("zipcode.tar" . "SKK-JISYO.office.zipcode")))) - (dolist (c list) - (tar-salvage-file (expand-file-name (car c) dir) - (cdr c) - (expand-file-name (cdr c) dir))))) + "SKK$B<-=q$r%@%&%s%m!<%I$7!"(B`skk-dict-collection' $B$K4p$E$-E83+!&J]B8$9$k!#(B" + (let ((base-url "https://skk-dev.github.io/dict/")) + ;; ($B%U%!%$%kL>(B . $B@_Dj(B) $B$rD>@\J,2r$7$F%k!<%W(B + (pcase-dolist (`(,f . ,conf) skk-dict-collection) + (let* ((dest-name (if (eq conf 'archive) + (replace-regexp-in-string "\\.tar\\.gz\\'" "" f) + (replace-regexp-in-string "\\.gz\\'" "" f))) + (dest-path (expand-file-name dest-name dir)) + (url (concat base-url f)) + (tmp-gz (expand-file-name f dir))) ; $B0l;~J]B8MQ%Q%9(B + + (unless (file-exists-p dest-path) + (message "Downloading %s..." f) + ;; unwind-protect $B$G%(%i!<;~$b0l;~%U%!%$%k$r3NC5n(B + (unwind-protect + (progn + (url-copy-file url tmp-gz t) + (skk-unpack-entry tmp-gz dir conf)) + (when (file-exists-p tmp-gz) + (delete-file tmp-gz)))))))) + +(defun skk-unpack-entry (file-path dest-dir config) + "CONFIG $B$K4p$E$-(B 'archive $B$+J8;z%3!<%I$+$rH=Dj$7$FE83+$9$k!#(B" + (let ((default-directory dest-dir) + (file-name (file-name-nondirectory file-path))) + (pcase config + ('archive + (if (executable-find "tar") ; Windows 10 $B0J9_$G$OI8=`(B + (call-process "tar" nil nil nil "-xf" file-path) + (error "tar $B%3%^%s%I$,8+$D$+$j$^$;$s(B: %s" file-name))) + + (coding + (let ((out-file (expand-file-name (replace-regexp-in-string "\\.gz\\'" "" file-name) + dest-dir)) + (coding-system-for-write coding)) + (with-temp-file out-file + (insert-file-contents file-path))))))) ;;;###autoload (defun skk-get (dir) @@ -104,8 +128,7 @@ (interactive (list (read-directory-name "skk-get directory: " (expand-file-name skk-get-jisyo-directory)))) (let ((jisyo-dir (expand-file-name dir))) (skk-get-mkdir jisyo-dir) - (skk-get-download jisyo-dir) - (skk-get-expand-tar jisyo-dir)) + (skk-get-download jisyo-dir)) (message "skk-get...done") nil) diff --git a/tar-util.el b/tar-util.el deleted file mode 100644 index b475d55f..00000000 --- a/tar-util.el +++ /dev/null @@ -1,147 +0,0 @@ -;;; tar-util.el --- utility for tar archive - -;; Copyright (C) 2016 Tsuyoshi Kitamoto - -;; Author: Tsuyoshi Kitamoto -;; Maintainer: SKK Development Team -;; URL: https://github.com/skk-dev/ddskk -;; Created: 22 Jan 2016 - -;; This file is part of Daredevil SKK. - -;; 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, either version 3 of -;; the License, 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 for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; 使い方 -;; o (tar-salvage-file "~/temp/foo.tar" "foo/bar.el" "~/bar.el") -;; アーカイブ foo.tar の中のファイル bar.el を取り出して、 -;; ~/bar.el として保存します。 - -;; o (tar-list-files "~/temp/foo.tar") -;; アーカイブ foo.tar の中のファイル群をリストで返します。 - -;;; shut up compiler warning. -(eval-when-compile - (declare-function tar--extract "tar-mode") - (declare-function tar-header-block-tokenize "tar-mode") - (declare-function tar-header-data-end "tar-mode") - (declare-function tar-header-name "tar-mode")) - -;;; Code: - -(require 'tar-mode) - -;;;###autoload -(defun tar-make-descriptor (buffer) - "BUFFER is made by function `tar-raw-buffer'. -Return list like `tar-parse-info', See `tar-mode'. -this function is based on `tar-summarize-buffer'." - (let ((result '()) - (pos (point-min)) - (coding (or file-name-coding-system - default-file-name-coding-system - locale-coding-system)) - descriptor) - (with-current-buffer buffer - (while (and (< pos (point-max)) - (setq descriptor (tar-header-block-tokenize pos coding))) - (let ((size (tar-header-size descriptor))) - (if (< size 0) - (error "%s has size %s - corrupted" - (tar-header-name descriptor) - size))) - (push descriptor result) - (setq pos (tar-header-data-end descriptor)))) ; END while - (nreverse result))) - -;;;###autoload -(defun tar-file-descriptor (buffer file) - "Return descriptor Structure for match FILE in BUFFER. -BUFFER is made by function `tar-raw-buffer'." - ;; (tar-file-descriptor (tar-raw-buffer "/temp/ddskk-16.0.52.tar") "ann") - ;; => [tar-header # - ;; "ddskk-16.0.52/skk-annotation.el" 436 1000 1000 64715 (22169 36584) 7124 nil - ;; "" "ustar " "brutus" "brutus" 0 0 nil] - (let ((descriptor (tar-make-descriptor buffer))) - (catch 'match - (dolist (d descriptor) - (when (string-match file (tar-header-name d)) - (throw 'match d)))))) - -;;;###autoload -(defun tar-raw-buffer (archive) - "ARCHIVE is path to tar archive. -Return buffer object." - (let* ((path (expand-file-name archive)) - (buffer (file-name-nondirectory path))) - - ;; バッファ名に tar の拡張子がある場合、バッファのコーディングが適切 - ;; に設定されない。この結果、skk-get でダウンロードした - ;; 以下の2つのファイルが展開されない。 - ;; 対処として、拡張子を ``tar'' → ``archive'' に変更する。 - ;; - SKK-JISYO.edict.tar - ;; - zipcode.tar - - ;; 参考 - ;; 拡張子が .tar のままだと、Emacs 内部の set-auto-coding ルーチンにおいて - ;; コーディング系の自動判別が機能しない（以下の処理ルートで抑制されるため）。 - ;; これを回避するため、一時的に拡張子を .archive へ置換している。 - ;; (tar--extract desc) - ;; (funcall set-auto-coding-function name (- end start)) - ;; (set-auto-coding filename size) - ;; (find-auto-coding filename size) - ;; (setq head-end (set-auto-mode-1)) - ;; (inhibit-local-variables-p) - - (if (string-match "\\.tar\\b" buffer) - (setq buffer (replace-match "archive" t t buffer))) - - (when (get-buffer buffer) - (kill-buffer buffer)) - (set-buffer (get-buffer-create buffer)) - (set-buffer-multibyte nil) - (insert-file-contents-literally path) - (zlib-decompress-region (point-min) - (point-max))) - (current-buffer)) - -;;;###autoload -(defun tar-list-files (archive) - "ARCHIVE is path to tar archive." - (let* ((buffer (tar-raw-buffer archive)) - (descriptor (tar-make-descriptor buffer))) - (kill-buffer buffer) - (mapcar #'tar-header-name - descriptor))) - -;;;###autoload -(defun tar-salvage-file (archive salvagefile savefile) - "Salvage SALVAGEFILE in ARCHIVE, and save to SAVEFILE." - (let* ((tar-data-buffer (tar-raw-buffer archive)) - (desc (tar-file-descriptor tar-data-buffer salvagefile))) - (set-buffer (tar--extract desc)) - (kill-buffer tar-data-buffer) - (set-buffer-file-coding-system last-coding-system-used t) - (setq buffer-file-name (expand-file-name savefile)) - (basic-save-buffer) - (kill-buffer nil))) - -(provide 'tar-util) - -;; Local Variables: -;; indent-tabs-mode: nil -;; End: - -;;; tar-util.el ends here