X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=WL-MK;h=88f8dc8ae46dfe962b2097821f00a3b0082f7207;hb=13ea09ab66b44b1a3b0971e1a24ce0da47a6ca0a;hp=fbc9789e9adc4b85597f5582bc4847bf4005c217;hpb=cc7c4d063c3ea29fdacc01d932314ceef66ac172;p=elisp%2Fwanderlust.git diff --git a/WL-MK b/WL-MK index fbc9789..88f8dc8 100644 --- a/WL-MK +++ b/WL-MK @@ -28,9 +28,19 @@ (defconst wl-en-info "wl.info") (defconst wl-en-texi "wl.texi") -(defvar wl-info-lang '("ja" "en") +(defvar wl-info-lang (if (featurep 'mule) '("ja" "en") '("en")) "The language of info file (\"ja\" or \"en\").") +;;; NEWS +(defvar wl-news-lang (if (featurep 'mule) '("ja" "en") '("en")) + "The language of news file (\"ja\" or \"en\").") +(defconst wl-news-news-file '(("en" "NEWS") + ("ja" "NEWS.ja"))) +(defconst wl-news-search-regexp + '(("en" "^\\* Changes in \\([0-9.]*\\) from [0-9.]+x?") + ("ja" "^\\* [0-9.]+x? から \\([0-9.]*\\) への変更点"))) +(defconst wl-news-filename "wl-news.el") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'cl) @@ -53,7 +63,7 @@ (defmacro defgroup (&rest args)) (defmacro defcustom (symbol value &optional doc &rest args) (let ((doc (concat "*" (or doc "")))) - (` (defvar (, symbol) (, value) (, doc)))))) + `(defvar ,symbol ,value ,doc)))) (load "bytecomp" nil t) @@ -148,7 +158,8 @@ (let ((version (mapconcat 'number-to-string (product-version (product-find 'elmo-version)) - "."))) + ".")) + (coding-system-for-write 'iso-latin-1-unix)) (princ (concat "Update version number to " version "\n")) ;; generate version.tex (with-temp-buffer @@ -164,6 +175,7 @@ (defun test-wl () "Run test suite for developer." (config-wl-package) + (make-wl-news) (require 'lunit) (let ((files (directory-files "tests" t "^test-.*\\.el$")) (suite (lunit-make-test-suite))) @@ -181,6 +193,9 @@ (defun check-wl () "Check user environment. Not for developer." (config-wl-package) + ;; Avoid load error + (provide 'wl-news) + (load "wl-news.el.in") (require 'lunit) (let ((files (directory-files "tests" t "^check-.*\\.el$")) (suite (lunit-make-test-suite))) @@ -197,67 +212,82 @@ (defun wl-scan-source (path) (let (ret) - (mapcar - '(lambda (x) - (mapcar '(lambda (y) - (setq ret (append (list y (concat y "c")) ret))) - (directory-files x nil "\\(.+\\)\\.el$" t))) + (mapc + (lambda (x) + (mapc (lambda (y) + (setq ret (append (list y (concat y "c")) ret))) + (directory-files x nil "\\(.+\\)\\.el$" t))) path) ret)) (defun wl-uninstall (objs path) ;(message (mapconcat 'identity objs " ")) - (mapcar - '(lambda (x) - (let ((filename (expand-file-name x path))) - (if (and (file-exists-p filename) - (file-writable-p filename)) - (progn - (princ (format "%s was uninstalled.\n" filename)) - (delete-file filename))))) + (mapc + (lambda (x) + (let ((filename (expand-file-name x path))) + (if (and (file-exists-p filename) + (file-writable-p filename)) + (progn + (princ (format "%s was uninstalled.\n" filename)) + (delete-file filename))))) objs)) +(defun wl-examine-modules () + "Examine wl modules should be byte-compile'd." + (config-wl-package-subr) + (make-wl-news) + (dolist (module modules-alist) + (dolist (filename (cdr module)) + (princ (format "%s/%s.elc " (car module) filename))))) + + (defun compile-wl-package () (config-wl-package) - (mapcar - '(lambda (x) - (compile-elisp-modules (cdr x) (car x))) + (make-wl-news) + (mapc + (lambda (x) + (compile-elisp-modules (cdr x) (car x))) modules-alist)) (defun install-wl-icons () (if (not (file-directory-p PIXMAPDIR)) (make-directory PIXMAPDIR t)) (let* ((case-fold-search t) - (icons (directory-files ICONDIR t + (icons (directory-files ICONDIR nil (cond ((featurep 'xemacs) "\\.x[bp]m$") ((and (boundp 'emacs-major-version) (>= emacs-major-version 21)) "\\.img$\\|\\.x[bp]m$") ((featurep 'mule) - "\\.img$\\|\\.xbm$")))) - icon dest) + "\\.img$\\|\\.xbm$"))))) + (install-files icons ICONDIR PIXMAPDIR nil 'overwrite))) + +(defun uninstall-wl-icons () + (let* ((case-fold-search t) + (icons (directory-files PIXMAPDIR t "\\.img$\\|\\.x[bp]m$")) + icon) (while icons (setq icon (car icons) - icons (cdr icons) - dest (expand-file-name (file-name-nondirectory icon) PIXMAPDIR)) - (princ (format "%s -> %s\n" - (file-name-nondirectory icon) - (substring (file-name-directory dest) 0 -1))) - (copy-file icon dest t)))) + icons (cdr icons)) + (if (and (file-exists-p icon) + (file-writable-p icon)) + (progn + (princ (format "%s was uninstalled.\n" icon)) + (delete-file icon)))))) (defun install-wl-package () (compile-wl-package) (let ((wl-install-dir (expand-file-name WL_PREFIX LISPDIR)) (elmo-install-dir (expand-file-name ELMO_PREFIX LISPDIR))) - (mapcar - '(lambda (x) - (install-elisp-modules (cdr x) (car x) - (if (string= (car x) ELMODIR) - elmo-install-dir - wl-install-dir))) + (mapc + (lambda (x) + (install-elisp-modules (cdr x) (car x) + (if (string= (car x) ELMODIR) + elmo-install-dir + wl-install-dir))) modules-alist)) (if PIXMAPDIR (install-wl-icons))) @@ -274,17 +304,7 @@ (wl-uninstall (wl-scan-source (list ELMODIR)) elmo-install-dir)) (if PIXMAPDIR - (let* ((case-fold-search t) - (icons (directory-files PIXMAPDIR t "\\.x[bp]m$")) - icon) - (while icons - (setq icon (car icons) - icons (cdr icons)) - (if (and (file-exists-p icon) - (file-writable-p icon)) - (progn - (princ (format "%s was uninstalled.\n" icon)) - (delete-file icon))))))) + (uninstall-wl-icons))) (defun config-wl-package-xmas () @@ -293,22 +313,12 @@ (config-wl-package-subr) ;; PACKAGEDIR check. (let (package-dir) - (and (setq package-dir (car command-line-args-left)) - (if (string= "NONE" package-dir) - (defvar PACKAGEDIR - (if (boundp 'early-packages) - (let ((dirs (append (if early-package-load-path - early-packages) - (if late-package-load-path - late-packages) - (if last-package-load-path - last-packages))) - dir) - (while (not (file-exists-p - (setq dir (car dirs)))) - (setq dirs (cdr dirs))) - dir))) - (defvar PACKAGEDIR package-dir))) + (defvar PACKAGEDIR + (if (and (setq package-dir (car command-line-args-left)) + (not (string= "NONE" package-dir))) + package-dir + (require 'install) + (install-get-default-package-directory))) (princ (format "PACKAGEDIR is %s\n" PACKAGEDIR)) (setq command-line-args-left (cdr command-line-args-left))) ;; PIXMAPDIR check. @@ -318,6 +328,7 @@ ;; from SEMI-MK (defun compile-wl-package-xmas () (config-wl-package-xmas) + (make-wl-news) (setq autoload-package-name "wl") (add-to-list 'command-line-args-left WLDIR) (batch-update-directory) @@ -325,9 +336,9 @@ (Custom-make-dependencies) ;; WL-AUTOLOAD-MODULES (compile-elisp-modules WL-AUTOLOAD-MODULES WLDIR) - (mapcar - '(lambda (x) - (compile-elisp-modules (cdr x) (car x))) + (mapc + (lambda (x) + (compile-elisp-modules (cdr x) (car x))) modules-alist)) (defun install-wl-package-xmas () @@ -346,9 +357,9 @@ ;; copy xpm files (install-wl-icons) - (mapcar '(lambda (x) - (install-elisp-modules (cdr x) (car x) LISPDIR)) - modules-alist) + (mapc (lambda (x) + (install-elisp-modules (cdr x) (car x) LISPDIR)) + modules-alist) ;; WL-AUTOLOAD-MODULES (install-elisp-modules WL-AUTOLOAD-MODULES WLDIR LISPDIR) ;; @@ -359,82 +370,176 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Texinfo stuff +(defun wl-texinfo-info-file (lang) + (symbol-value (intern (format "wl-%s-info" lang)))) + +(defun wl-texinfo-texi-file (lang) + (symbol-value (intern (format "wl-%s-texi" lang)))) + +(defun wl-texinfo-check-newer (lang) + (let ((info-file (expand-file-name (wl-texinfo-info-file lang) DOCDIR))) + (and + (file-newer-than-file-p info-file + (expand-file-name "version.texi" DOCDIR)) + (file-newer-than-file-p info-file + (expand-file-name (wl-texinfo-texi-file lang) DOCDIR))))) + (defun wl-texinfo-format-file (lang) - (let ((infofile (symbol-value (intern (format "wl-%s-info" lang)))) - (texifile (symbol-value (intern (format "wl-%s-texi" lang))))) - (require 'wl-vars) ;; for 'wl-cs-local - (or (file-newer-than-file-p (expand-file-name infofile DOCDIR) - (expand-file-name texifile DOCDIR)) - (let (obuf beg) - ;; Support old texinfmt.el - (require 'ptexinfmt (expand-file-name "ptexinfmt.el" UTILSDIR)) - (find-file (expand-file-name texifile DOCDIR)) - (setq obuf (current-buffer)) - ;; We can't know file names if splitted. - (texinfo-format-buffer t) - ;; Emacs20.2's default is 'raw-text-unix. - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system wl-cs-local)) - (save-buffer) - (kill-buffer (current-buffer)) ;; info - (kill-buffer obuf)) ;; texi - ))) + (require 'wl-vars) ;; for 'wl-cs-local + (or (wl-texinfo-check-newer lang) + (let (obuf) + ;; Support old texinfmt.el + (require 'ptexinfmt (expand-file-name "ptexinfmt.el" UTILSDIR)) + (find-file (expand-file-name (wl-texinfo-texi-file lang) DOCDIR)) + (setq obuf (current-buffer)) + ;; We can't know file names if splitted. + (texinfo-format-buffer t) + ;; Emacs20.2's default is 'raw-text-unix. + (and (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system wl-cs-local)) + (save-buffer) + (kill-buffer (current-buffer)) ;; info + (kill-buffer obuf)) ;; texi + )) (defun wl-texinfo-format () - (unless INFODIR - (setq INFODIR (wl-detect-info-directory))) - (cond ((listp wl-info-lang) - (mapcar 'wl-texinfo-format-file wl-info-lang)) + (wl-detect-info-directory) + (cond ((null wl-info-lang)) + ((listp wl-info-lang) + (mapc 'wl-texinfo-format-file wl-info-lang)) ((stringp wl-info-lang) (wl-texinfo-format-file wl-info-lang)))) (defun wl-texinfo-install-file (lang) - (let ((infofile (symbol-value (intern (format "wl-%s-info" lang))))) + (let ((infofile (wl-texinfo-info-file lang))) (install-file infofile DOCDIR INFODIR nil 'overwrite))) (defun wl-texinfo-install () - (cond ((listp wl-info-lang) - (mapcar 'wl-texinfo-install-file wl-info-lang)) + (cond ((null wl-info-lang)) + ((listp wl-info-lang) + (mapc 'wl-texinfo-install-file wl-info-lang)) ((stringp wl-info-lang) (wl-texinfo-install-file wl-info-lang)))) (defun wl-primary-info-file () "Get primary info file (for wl-detect-info-directory)." - (cond - ((listp wl-info-lang) - (let ((wl-info-lang (car wl-info-lang))) - (wl-primary-info-file))) - ((stringp wl-info-lang) - (symbol-value (intern (format "wl-%s-info" wl-info-lang)))))) + (cond ((null wl-info-lang)) + ((listp wl-info-lang) + (let ((wl-info-lang (car wl-info-lang))) + (wl-primary-info-file))) + ((stringp wl-info-lang) + (wl-texinfo-info-file wl-info-lang)))) (defun wl-detect-info-directory () (config-wl-package-subr) ;; INFODIR check. - (require 'info) - (if (fboundp 'info-initialize) - (info-initialize)) - (let ((infodir (car command-line-args-left)) - (info (wl-primary-info-file)) - previous INFODIR) - (setq INFODIR - (if (string= infodir "NONE") - (if (setq previous - (exec-installed-p info Info-directory-list - COMPRESS-SUFFIX-LIST)) - ;;(progn - ;;(condition-case nil (delete-file previous)) - (directory-file-name (file-name-directory previous));) - (car Info-directory-list)) - infodir)) - (setq command-line-args-left (cdr command-line-args-left)) - (princ (format "INFODIR is %s\n\n" INFODIR)) - INFODIR)) + (when wl-info-lang + (require 'info) + (if (fboundp 'info-initialize) + (info-initialize)) + (unless INFODIR + (let ((infodir (car command-line-args-left)) + (info (wl-primary-info-file)) + previous) + (setq INFODIR + (if (string= infodir "NONE") + (if (setq previous + (exec-installed-p info Info-directory-list + COMPRESS-SUFFIX-LIST)) + (directory-file-name (file-name-directory previous)) + (car Info-directory-list)) + infodir)) + (setq command-line-args-left (cdr command-line-args-left)))) + (princ (format "INFODIR is %s\n\n" INFODIR)))) (defun install-wl-info () (wl-texinfo-format) (wl-texinfo-install)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; wl-news stuff + +(defun wl-news-news-file (lang) + (cadr (assoc lang wl-news-news-file))) + +(defun wl-news-check-newer (out-filename news-lang) + (let ((lang news-lang) + ret) + (while (car lang) + (if (file-newer-than-file-p + (wl-news-news-file (car lang)) out-filename) + (setq ret t)) + (setq lang (cdr lang))) + ret)) + +(defun make-wl-news () + (let ((in-filename + (expand-file-name (concat wl-news-filename ".in") WLDIR)) + (out-filename + (expand-file-name wl-news-filename WLDIR)) + (wl-news-lang (if (listp wl-news-lang) + wl-news-lang + (list wl-news-lang)))) + (if (or (file-newer-than-file-p in-filename out-filename) + (wl-news-check-newer out-filename wl-news-lang)) + (with-temp-buffer + (save-excursion + (insert-file-contents in-filename) + (goto-char (point-min)) + (unless (re-search-forward "^;;; -\\*- news-list -\\*-" nil t) + (error "Invalid wl-news.el.in")) + (forward-line 2) + (if wl-news-lang + (progn + (insert "(defconst wl-news-news-alist\n '") + (let ((p (point))) + (prin1 (wl-news-parse-news wl-news-lang) (current-buffer)) + (save-excursion + (narrow-to-region p (point)) + (goto-char (1+ p)) + (while (re-search-forward "^(" nil t) + (replace-match "\\\\(")) ; avoid font-lock confusion + (widen))) + (insert ")\n")) + (insert "(defconst wl-news-news-alist nil)\n\n")) + (let ((buffer-file-coding-system (mime-charset-to-coding-system 'x-ctext))) + (write-region (point-min) (point-max) out-filename))))))) + +(defun wl-news-parse-news (lang) + (let (news-list) + (while (car lang) + (setq news-list (cons + (cons (car lang) (wl-news-parse-news-subr (car lang))) + news-list)) + (setq lang (cdr lang))) + news-list)) + +(defun wl-news-parse-news-subr (lang) + (let ((filename (wl-news-news-file lang)) + (reg (cadr (assoc lang wl-news-search-regexp))) + news-list) + (if (and filename reg) + (with-temp-buffer + (insert-file-contents filename) + (while (re-search-forward reg nil t) + (let ((beg (match-beginning 0)) + (version-tmp (split-string (match-string 1) "\\.")) + version news-string end) + (while version-tmp + (setq version (append version (list (string-to-number (car version-tmp))))) + (setq version-tmp (cdr version-tmp))) + (re-search-forward "^\\(\\* \\| \\)" nil t) + (goto-char (- (match-beginning 0) 1)) + (setq end (point)) + (setq news-string (buffer-substring beg end)) + (setq news-list + (append news-list + (list (cons version news-string)))))))) + news-list)) + + + ;;; ToDo ;;; * MORE refine code (^_^;