Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

547 lines (481 sloc) 16.707 kb
;;; -*- Emacs-Lisp -*-
;;; WL-MK for byte-compile, install, uninstall
;;;
;;; Original by OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
;;; Modified by Yuuichi Teranishi <teranisi@gohome.org>
;;;;;;;;;;;;;;;;;;;;; DO NOT EDIT THIS FILE ;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;; INTERNAL USE ONLY ;;;;;;;;;;;;;;;;;;;;;
;;; Code
(defvar WLDIR "./wl")
(defvar ELMODIR "./elmo")
(defvar DOCDIR "./doc")
(defvar ICONDIR "./etc/icons")
(defvar UTILSDIR "./utils")
(defvar WL_PREFIX "wl")
(defvar ELMO_PREFIX "wl")
(defvar COMPRESS-SUFFIX-LIST '("" ".gz" ".Z" ".bz2"))
(defvar wl-install-utils nil
"If Non-nil, install `wl-utils-modules'.")
;;; INFO
(defconst wl-ja-info "wl-ja.info")
(defconst wl-ja-texi "wl-ja.texi")
(defconst wl-en-info "wl.info")
(defconst wl-en-texi "wl.texi")
(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? $B$+$i(B \\([0-9.]*\\) $B$X$NJQ99E@(B")))
(defconst wl-news-filename "wl-news.el")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'cl)
(defvar INFODIR nil)
(condition-case () (require 'custom) (error nil))
;; for wl-vars.el
(unless (and (fboundp 'defgroup)
(fboundp 'defcustom)
;; ignore broken module
(not (featurep 'tinycustom)))
(when (and (boundp 'emacs-major-version)
(= emacs-major-version 19)
(>= emacs-minor-version 29))
(message "%s" "
Warning: You don't seem to have \"new custom\" package installed.
See README file of APEL package for more information.
"))
(require 'backquote)
(defmacro defgroup (&rest args))
(defmacro defcustom (symbol value &optional doc &rest args)
(let ((doc (concat "*" (or doc ""))))
`(defvar ,symbol ,value ,doc))))
(load "bytecomp" nil t)
(unless (fboundp 'byte-compile-file-form-custom-declare-variable)
;; Bind defcustom'ed variables.
(put 'custom-declare-variable 'byte-hunk-handler
'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
(if (memq 'free-vars byte-compile-warnings)
(setq byte-compile-bound-variables
(cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
form))
(condition-case nil
(char-after)
(wrong-number-of-arguments
;; Optimize byte code for `char-after'.
(put 'char-after 'byte-optimizer 'byte-optimize-char-after)
(defun byte-optimize-char-after (form)
(if (null (cdr form))
'(char-after (point))
form))))
(setq byte-compile-warnings '(free-vars unresolved callargs redefine))
;; v18, v19
(if (boundp 'MULE)
(setq max-lisp-eval-depth 400))
;; FIXME: it is currently needed to byte-compile with Emacs 21.
(setq recursive-load-depth-limit nil)
(condition-case () (require 'easymenu) (error nil))
(defvar config-wl-package-done nil)
(defun config-wl-package-subr ()
(unless config-wl-package-done
(setq config-wl-package-done t)
(setq load-path (cons (expand-file-name ".") load-path))
(setq load-path (cons (expand-file-name WLDIR)
(cons (expand-file-name ELMODIR) load-path)))
;; load custom file if exists. `WL-CFG.el' override for committer.
(load "./WL-CFG" t nil nil)
;; load-path
(if wl-install-utils
(setq load-path (cons (expand-file-name UTILSDIR) load-path)))
(require 'install)
(load "./WL-ELS" nil nil t)
;; product.el version check
(require 'product)
(if (not (fboundp 'product-version-as-string))
(error "Please install new APEL. See INSTALL or INSTALL.ja"))
;; smtp.el version check.
(require 'smtp)
(if (not (fboundp 'smtp-send-buffer))
(error "Please install new FLIM. See INSTALL or INSTALL.ja"))
(condition-case ()
(require 'mime-setup)
(error (error "Cannot load `mime-setup'. Please install SEMI")))))
(defun config-wl-pixmap-dir (&optional packagedir)
"Examine pixmap directory where icon files should go."
(let ((pixmap-dir (car command-line-args-left)))
(defvar PIXMAPDIR
(if (string= pixmap-dir "NONE")
(if packagedir
(expand-file-name "etc/wl/" packagedir)
(expand-file-name "wl/icons/" data-directory))
pixmap-dir)))
(if PIXMAPDIR
(princ (format "PIXMAPDIR is %s\n" PIXMAPDIR)))
(setq command-line-args-left (cdr command-line-args-left)))
(defun config-wl-package ()
(config-wl-package-subr)
;; LISPDIR check.
(let ((elispdir (car command-line-args-left)))
(if (string= elispdir "NONE")
(defvar LISPDIR (install-detect-elisp-directory))
(defvar LISPDIR elispdir)))
(princ (format "LISPDIR is %s\n" LISPDIR))
(setq command-line-args-left (cdr command-line-args-left))
;; PIXMAPDIR check.
(config-wl-pixmap-dir)
(princ "\n"))
(defun update-version ()
"Update version number of documents."
(config-wl-package)
(load-file "elmo/elmo-version.el")
(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
(insert "\\def\\versionnumber{" version "}\n")
(write-region (point-min) (point-max) (expand-file-name
"version.tex" "doc")))
;; generate version.texi
(with-temp-buffer
(insert "@set VERSION " version "\n")
(write-region (point-min) (point-max) (expand-file-name
"version.texi" "doc")))))
(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)))
(while files
(if (file-regular-p (car files))
(progn
(load-file (car files))
(lunit-test-suite-add-test
suite (lunit-make-test-suite-from-class
(intern (file-name-sans-extension
(file-name-nondirectory (car files))))))))
(setq files (cdr files)))
(lunit suite)))
(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)))
(while files
(if (file-regular-p (car files))
(progn
(load-file (car files))
(lunit-test-suite-add-test
suite (lunit-make-test-suite-from-class
(intern (file-name-sans-extension
(file-name-nondirectory (car files))))))))
(setq files (cdr files)))
(lunit suite)))
(defun wl-scan-source (path)
(let (ret)
(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 " "))
(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)
(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 nil
(cond ((featurep 'xemacs)
"\\.x[bp]m$")
((and (boundp 'emacs-major-version)
(>= emacs-major-version 21))
"\\.img$\\|\\.x[bp]m$")
((featurep 'mule)
"\\.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))
(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)))
(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)))
(defun uninstall-wl-package ()
(config-wl-package)
(let ((wl-install-dir (expand-file-name WL_PREFIX
LISPDIR))
(elmo-install-dir (expand-file-name ELMO_PREFIX
LISPDIR)))
(wl-uninstall (wl-scan-source (list WLDIR UTILSDIR))
wl-install-dir)
(wl-uninstall (wl-scan-source (list ELMODIR))
elmo-install-dir))
(if PIXMAPDIR
(uninstall-wl-icons)))
(defun config-wl-package-xmas ()
(if (not (featurep 'xemacs))
(error "This directive is only for XEmacs"))
(config-wl-package-subr)
;; PACKAGEDIR check.
(let (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.
(config-wl-pixmap-dir PACKAGEDIR)
(princ "\n"))
;; 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)
(add-to-list 'command-line-args-left WLDIR)
(Custom-make-dependencies)
;; WL-AUTOLOAD-MODULES
(compile-elisp-modules WL-AUTOLOAD-MODULES WLDIR)
(mapc
(lambda (x)
(compile-elisp-modules (cdr x) (car x)))
modules-alist))
(defun install-wl-package-xmas ()
(compile-wl-package-xmas)
(let ((LISPDIR (expand-file-name "wl"
(expand-file-name "lisp"
PACKAGEDIR)))
(DATADIR (expand-file-name "wl"
(expand-file-name "etc"
PACKAGEDIR)))
(INFODIR (expand-file-name "info" PACKAGEDIR)))
(or (file-exists-p DATADIR)
(make-directory DATADIR t))
(or (file-exists-p INFODIR)
(make-directory INFODIR t))
;; copy xpm files
(install-wl-icons)
(mapc (lambda (x)
(install-elisp-modules (cdr x) (car x) LISPDIR))
modules-alist)
;; WL-AUTOLOAD-MODULES
(install-elisp-modules WL-AUTOLOAD-MODULES WLDIR LISPDIR)
;;
(wl-texinfo-format)
(wl-texinfo-install)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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)
(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 ()
(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 (wl-texinfo-info-file lang)))
(install-file infofile DOCDIR INFODIR nil 'overwrite)))
(defun wl-texinfo-install ()
(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 ((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.
(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 (^_^;
;;; End
Jump to Line
Something went wrong with that request. Please try again.