439 lines
18 KiB
EmacsLisp
439 lines
18 KiB
EmacsLisp
;;; nxhtmlmaint.el --- Some maintenance helpers
|
|
;;
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
|
;; Created: 2008-09-27T15:29:35+0200 Sat
|
|
;; Version: 0.6
|
|
;; Last-Updated: 2010-01-18 Mon
|
|
;; URL:
|
|
;; Keywords:
|
|
;; Compatibility:
|
|
;;
|
|
;; Features that might be required by this library:
|
|
;;
|
|
;; None
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; This module contains maintenance functions:
|
|
;;
|
|
;; `nxhtmlmaint-get-all-autoloads' (nxhtmlmaint-get-all-autoloads)
|
|
;;
|
|
;; `nxhtmlmaint-start-byte-compilation'
|
|
;; `nxhtmlmaint-byte-uncompile-all'
|
|
;;
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Change log:
|
|
;;
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; 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 2, 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; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'advice))
|
|
(eval-when-compile (require 'nxhtml-base))
|
|
(eval-when-compile (require 'nxhtml-web-vcs nil t))
|
|
(eval-when-compile (require 'web-vcs nil t))
|
|
(eval-when-compile (require 'ourcomments-util))
|
|
|
|
(defvar nxhtmlmaint-dir
|
|
;;(file-name-directory (if load-file-name load-file-name buffer-file-name))
|
|
(file-name-directory (or load-file-name
|
|
(when (boundp 'bytecomp-filename) bytecomp-filename)
|
|
buffer-file-name))
|
|
"Maintenance directory for nXhtml.")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; Autoload helpers
|
|
|
|
(defun nxhtmlmaint-autoloads-file ()
|
|
"Return autoload file name for nXhtml."
|
|
(file-truename (expand-file-name "nxhtml-loaddefs.el" nxhtmlmaint-dir)))
|
|
|
|
(defun nxhtmlmaint-util-dir ()
|
|
"Return nXhtml util directory."
|
|
(file-truename (file-name-as-directory
|
|
(expand-file-name "util" nxhtmlmaint-dir))))
|
|
|
|
(defvar nxhtmlmaint-autoload-default-directory (nxhtmlmaint-util-dir))
|
|
|
|
(defvar generated-autoload-file)
|
|
|
|
(defun nxhtmlmaint-initialize-autoloads-file ()
|
|
"Initialize nXhtml autoload file."
|
|
(with-current-buffer (find-file-noselect generated-autoload-file)
|
|
(when (= 0 (buffer-size))
|
|
(insert ";; Autoloads for nXthml
|
|
;;
|
|
;; This file should be updated by `nxhtmlmaint-get-file-autoloads',
|
|
;; `nxhtmlmaint-get-dir-autoloads' or `nxhtmlmaint-get-all-autoloads'.
|
|
\(eval-when-compile (require 'nxhtml-base))
|
|
\(eval-when-compile (require 'web-vcs))")
|
|
(basic-save-buffer))))
|
|
|
|
(defun nxmtmlmaint-advice-autoload (on)
|
|
"Activate advices if ON, otherwise turn them off."
|
|
(if on
|
|
(progn
|
|
(ad-activate 'autoload-file-load-name)
|
|
(ad-activate 'make-autoload))
|
|
(ad-deactivate 'autoload-file-load-name)
|
|
(ad-deactivate 'make-autoload)))
|
|
|
|
(defun nxhtmlmaint-get-file-autoloads (file)
|
|
"Get autoloads for file FILE.
|
|
Update nXhtml autoload file with them."
|
|
(interactive (list (buffer-file-name)))
|
|
(let* ((generated-autoload-file (nxhtmlmaint-autoloads-file))
|
|
(emacs-lisp-mode-hook nil)
|
|
(default-directory (nxhtmlmaint-util-dir)))
|
|
(nxhtmlmaint-initialize-autoloads-file)
|
|
;; Get the autoloads using advice
|
|
(nxmtmlmaint-advice-autoload t)
|
|
(update-file-autoloads file nil)
|
|
(nxmtmlmaint-advice-autoload nil)
|
|
;; Display
|
|
(display-buffer (find-file-noselect generated-autoload-file))))
|
|
|
|
(defun nxhtmlmaint-get-dir-autoloads (dir)
|
|
"Get autoloads for directory DIR.
|
|
Update nXhtml autoload file with them."
|
|
(interactive (list (or (when (buffer-file-name)
|
|
(file-name-directory (buffer-file-name)))
|
|
default-directory)))
|
|
(let* ((generated-autoload-file (nxhtmlmaint-autoloads-file))
|
|
(emacs-lisp-mode-hook nil)
|
|
(auto-buf (find-file-noselect generated-autoload-file)))
|
|
(nxhtmlmaint-initialize-autoloads-file)
|
|
;; Get the autoloads using advice
|
|
(nxmtmlmaint-advice-autoload t)
|
|
;; Fix-me: Loop instead, some files must be avoided.
|
|
(update-directory-autoloads dir)
|
|
(nxmtmlmaint-advice-autoload nil)
|
|
;; Display
|
|
(display-buffer (find-file-noselect generated-autoload-file))))
|
|
|
|
(defun nxhtmlmaint-get-tree-autoloads (root)
|
|
"Get autoloads for directory tree ROOT.
|
|
Update nXhtml autoload file with them."
|
|
(interactive (list (or (when (buffer-file-name)
|
|
(file-name-directory (buffer-file-name)))
|
|
default-directory)))
|
|
(message "Getting autoloads in %s" root)
|
|
(nxhtmlmaint-get-dir-autoloads root)
|
|
(let* ((files (directory-files root))
|
|
(sub-dirs (mapcar (lambda (file)
|
|
(when (and (not (member file '("." "..")))
|
|
(not (member file '("nxml-mode-20041004" "old")))
|
|
(not (member file '("nxhtml-company-mode")))
|
|
(not (member file '("in")))
|
|
(file-directory-p (expand-file-name file root)))
|
|
file))
|
|
files)))
|
|
(setq sub-dirs (delq nil sub-dirs))
|
|
;;(message "sub-dirs=%s" sub-dirs)
|
|
(dolist (dir sub-dirs)
|
|
(let ((full-dir (expand-file-name dir root)))
|
|
(unless (or (string= full-dir nxhtmlmaint-dir)
|
|
(string= dir "alts"))
|
|
(nxhtmlmaint-get-tree-autoloads full-dir))))))
|
|
|
|
;;(nxhtmlmaint-get-all-autoloads)
|
|
(defun nxhtmlmaint-get-all-autoloads ()
|
|
"Get all autoloads for nXhtml.
|
|
Update nXhtml autoload file with them."
|
|
;;(interactive)
|
|
(if nxhtml-autoload-web
|
|
(message "Skipping rebuilding autoloads, not possible when autoloading from web")
|
|
(let ((auto-buf (find-file-noselect (nxhtmlmaint-autoloads-file))))
|
|
(with-current-buffer auto-buf
|
|
(erase-buffer)
|
|
(basic-save-buffer))
|
|
(nxhtmlmaint-get-tree-autoloads nxhtmlmaint-dir)
|
|
;; `nxhtml-mode' and `nxhtml-validation-header-mode' should only be
|
|
;; autoloaded if nxml-mode if available.
|
|
(with-current-buffer auto-buf
|
|
(message "Fixing nxml autoloads")
|
|
(let ((frmt (if (= emacs-major-version 22)
|
|
"^(autoload (quote %s) "
|
|
"^(autoload '%s ")))
|
|
(dolist (nxmode '(nxhtml-mode nxhtml-validation-header-mode))
|
|
(goto-char (point-min))
|
|
(when (re-search-forward (format frmt nxmode) nil t)
|
|
(forward-line 0)
|
|
(insert "(when (fboundp 'nxml-mode)\n")
|
|
(forward-sexp)
|
|
(insert ")"))))
|
|
;; Fix defcustom autoloads
|
|
(goto-char (point-min))
|
|
(let ((cus-auto "(\\(custom-autoload\\) +'.* +\\(\".*?\"\\)"))
|
|
(while (re-search-forward cus-auto nil t)
|
|
;;(backward-char (1- (length cus-auto)))
|
|
;;(insert "nxhtml-")
|
|
(let ((lib (match-string 2)))
|
|
;; Change to symbol to fix autoloading. This works because
|
|
;; custom-load-symbol does require on symbols.
|
|
(setq lib (concat "'" (substring lib 1 -1)))
|
|
(replace-match "nxhtml-custom-autoload" t t nil 1)
|
|
(replace-match lib t t nil 2))))
|
|
;; Fix autoload calls
|
|
(goto-char (point-min))
|
|
(let ((auto "(autoload "))
|
|
(while (search-forward auto nil t)
|
|
(backward-char (1- (length auto)))
|
|
(insert "nxhtml-")))
|
|
;; Fix autoload source
|
|
(goto-char (point-min))
|
|
(let* ((patt-src "^;;; Generated autoloads from \\(.*\\)$")
|
|
(patt-auto "^(nxhtml-autoload '[^ ]+ \\(\"[^\"]+\"\\)")
|
|
(patt-cust "^(nxhtml-custom-autoload '[^ ]+ \\(\"[^\"]+\"\\)")
|
|
(patt (concat "\\(?:" patt-src "\\)\\|\\(?:" patt-auto "\\)\\|\\(?:" patt-cust "\\)"))
|
|
curr-src)
|
|
(while (re-search-forward patt nil t)
|
|
(cond
|
|
( (match-string 1)
|
|
(setq curr-src (match-string-no-properties 1))
|
|
;; Remove .el
|
|
(setq curr-src (substring curr-src 0 -3))
|
|
;; Setup up for web autoload
|
|
(let* ((src-name (file-name-nondirectory curr-src))
|
|
(feature (make-symbol src-name))
|
|
)
|
|
(end-of-line)
|
|
(insert "\n"
|
|
"(web-autoload-require '"
|
|
(symbol-name feature)
|
|
" 'lp"
|
|
" '(nxhtml-download-root-url nil)"
|
|
" \"" curr-src "\""
|
|
" nxhtml-install-dir"
|
|
" 'nxhtml-byte-compile-file"
|
|
")\n"))
|
|
)
|
|
( (match-string 3)
|
|
;; (custom-autoload 'sym "lib" nil) is will give a
|
|
;; (require 'lib) so everything is ok here.
|
|
nil)
|
|
( (or (match-string 2)
|
|
(match-string 3)
|
|
)
|
|
(let* ((subexp (if (match-string 2) 2 3))
|
|
(file (match-string-no-properties subexp)))
|
|
(replace-match (concat "`(lp '(nxhtml-download-root-url nil)"
|
|
" \"" curr-src "\""
|
|
" nxhtml-install-dir)")
|
|
nil ;; fixedcase
|
|
nil ;; literal
|
|
nil ;; string
|
|
subexp ;; subexp
|
|
))
|
|
)
|
|
(t (error "No match???")))))
|
|
;; Save
|
|
(basic-save-buffer)))))
|
|
|
|
|
|
(defun nxhtmlmaint-autoload-file-load-name (file)
|
|
"Return relative file name for FILE to autoload file directory."
|
|
(let ((name (if (and nxhtmlmaint-autoload-default-directory
|
|
(file-name-absolute-p file))
|
|
(file-relative-name
|
|
file nxhtmlmaint-autoload-default-directory)
|
|
(file-name-nondirectory file))))
|
|
(if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
|
|
(substring name 0 (match-beginning 0))
|
|
name)))
|
|
|
|
(defadvice autoload-file-load-name (around
|
|
nxhtmlmaint-advice-autoload-file-load-name
|
|
;;activate
|
|
compile)
|
|
"Advice to return relative file name."
|
|
(setq ad-return-value (nxhtmlmaint-autoload-file-load-name (ad-get-arg 0))))
|
|
|
|
(defun nxhtmlmaint-make-autoload (form file)
|
|
"Make autoload for multi major modes."
|
|
;;(message "form=%S" form)
|
|
(if (or (not (listp form))
|
|
(not (eq 'define-mumamo-multi-major-mode (car form))))
|
|
ad-return-value
|
|
(if ad-return-value
|
|
ad-return-value
|
|
;; Fix-me: Maybe expand??
|
|
(let ((name (nth 1 form))
|
|
(doc (nth 2 form)))
|
|
`(autoload ',name ,file ,doc t)
|
|
))))
|
|
|
|
(defadvice make-autoload (after
|
|
nxhtmlmaint-advice-make-autoload
|
|
;;activate
|
|
compile)
|
|
"Make autoload for multi major modes."
|
|
(setq ad-return-value
|
|
(nxhtmlmaint-make-autoload (ad-get-arg 0)
|
|
(ad-get-arg 1))))
|
|
|
|
;; (defun nxhtmlmaint-generate-library-autoloads (library)
|
|
;; "Insert at point autoloads for Emacs library LIBRARY.
|
|
;; Works like `generate-file-autoloads', but for a library."
|
|
;; (interactive
|
|
;; (list (completing-read "Generate autoloads for library: "
|
|
;; 'locate-file-completion
|
|
;; (cons load-path (get-load-suffixes)))))
|
|
;; (let ((file (locate-library library)))
|
|
;; ;; Fix-me: wasn't this defined???
|
|
;; (generate-file-autoloads file)))
|
|
|
|
;;;###autoload
|
|
(defun nxhtmlmaint-start-byte-compilation ()
|
|
"Start byte compilation of nXhtml in new Emacs instance.
|
|
Byte compiling in general makes elisp code run 5-10 times faster
|
|
which is quite noticeable when you use nXhtml.
|
|
|
|
This will also update the file nxhtml-loaddefs.el.
|
|
|
|
You must restart Emacs to use the byte compiled files.
|
|
|
|
If for some reason the byte compiled files does not work you can
|
|
remove then with `nxhtmlmaint-byte-uncompile-all'."
|
|
(interactive)
|
|
;; Fix-me: This message and redisplay seems only necessary sometimes.
|
|
(message "Preparing byte compilation of nXhtml ...") (redisplay t)
|
|
(let* ((this-file (expand-file-name "nxhtmlmaint.el" nxhtmlmaint-dir))
|
|
(auto-file (expand-file-name "autostart.el" nxhtmlmaint-dir))
|
|
(web-vcs-file (expand-file-name "nxhtml-web-vcs.el" nxhtmlmaint-dir))
|
|
(this-emacs (locate-file invocation-name
|
|
(list invocation-directory)
|
|
exec-suffixes))
|
|
(process-args `(,this-emacs nil 0 nil "-Q")))
|
|
(nxhtmlmaint-byte-uncompile-all)
|
|
(if (or noninteractive
|
|
(not window-system))
|
|
(nxhtmlmaint-byte-compile-all)
|
|
;;(when noninteractive (setq process-args (append process-args '("-batch"))))
|
|
(setq process-args (append process-args
|
|
(list "-l" auto-file
|
|
"-l" web-vcs-file
|
|
"-l" this-file
|
|
"-f" "nxhtmlmaint-byte-compile-all")))
|
|
(message "process-args=%S" process-args)
|
|
(message "Starting new Emacs instance for byte compiling ...")
|
|
(apply 'call-process process-args))))
|
|
|
|
;;(nxhtmlmaint-byte-compile-all)
|
|
(defun nxhtmlmaint-byte-compile-all ()
|
|
"Byte recompile all files in nXhtml that needs it."
|
|
(message "nxhtmlmaint-byte-compile-all: nxhtmlmaint-dir=%S, exists=%s" nxhtmlmaint-dir (file-directory-p nxhtmlmaint-dir))
|
|
(let* ((load-path load-path)
|
|
(nxhtml-dir (file-name-as-directory
|
|
(expand-file-name "nxhtml"
|
|
nxhtmlmaint-dir)))
|
|
(util-dir (file-name-as-directory
|
|
(expand-file-name "util"
|
|
nxhtmlmaint-dir)))
|
|
;; (nxhtml-company-dir (file-name-as-directory
|
|
;; (expand-file-name "nxhtml-company-mode"
|
|
;; util-dir)))
|
|
(related-dir (file-name-as-directory
|
|
(expand-file-name "related"
|
|
nxhtmlmaint-dir)))
|
|
(tests-dir (file-name-as-directory
|
|
(expand-file-name "tests"
|
|
nxhtmlmaint-dir)))
|
|
(emacsw32-dir (file-name-as-directory
|
|
(expand-file-name "../lisp"
|
|
nxhtmlmaint-dir)))
|
|
(default-dir nxhtml-dir)
|
|
)
|
|
(message "nxhtmlmaint-byte-compile-all: nxhtml-dir=%S, exists=%s" nxhtml-dir (file-directory-p nxhtml-dir))
|
|
(message "nxhtmlmaint-byte-compile-all: util-dir=%S, exists=%s" util-dir (file-directory-p util-dir))
|
|
(message "nxhtmlmaint-byte-compile-all: related-dir=%S, exists=%s" related-dir (file-directory-p related-dir))
|
|
(message "nxhtmlmaint-byte-compile-all: tests-dir=%S, exists=%s" tests-dir (file-directory-p tests-dir))
|
|
(add-to-list 'load-path nxhtml-dir)
|
|
(add-to-list 'load-path util-dir)
|
|
;;(add-to-list 'load-path nxhtml-company-dir)
|
|
(add-to-list 'load-path related-dir)
|
|
(add-to-list 'load-path tests-dir)
|
|
(when (file-directory-p emacsw32-dir)
|
|
(add-to-list 'load-path emacsw32-dir))
|
|
(require 'cl) ;; This is run in a new Emacs. Fix-me: This might not be true any more.
|
|
(message "load-path=%s" load-path)
|
|
(let ((dummy-debug-on-error t))
|
|
(nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir nil nil nil))
|
|
(web-vcs-message-with-face 'web-vcs-gold "Byte compiling nXhtml is ready, restart Emacs to use the compiled files")))
|
|
|
|
;;;###autoload
|
|
(defun nxhtmlmaint-byte-recompile ()
|
|
"Recompile or compile all nXhtml files in current Emacs."
|
|
(interactive)
|
|
(nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir nil nil t)
|
|
(web-vcs-message-with-face 'web-vcs-gold "Byte recompiling nXhtml ready"))
|
|
|
|
;;;###autoload
|
|
(defun nxhtmlmaint-byte-uncompile-all ()
|
|
"Delete byte compiled files in nXhtml.
|
|
This will also update the file nxhtml-loaddefs.el.
|
|
|
|
See `nxhtmlmaint-start-byte-compilation' for byte compiling."
|
|
(interactive)
|
|
(nxhtmlmaint-get-all-autoloads)
|
|
(let ((dummy-debug-on-error t))
|
|
(nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir t t nil))
|
|
(message "Byte uncompiling is ready, restart Emacs to use the elisp files"))
|
|
|
|
(defconst nxhtmlmaint-nonbyte-compile-dirs
|
|
'("." ".." "alts" "nxml-mode-20041004" "old" "tests" "nxhtml-company-mode"))
|
|
|
|
;; Fix-me: simplify this now that nxml is not included
|
|
(defun nxhtmlmaint-byte-compile-dir (dir force del-elc load)
|
|
"Byte compile or uncompile directory tree DIR.
|
|
If FORCE is non-nil byte recompile the elisp file even if the
|
|
compiled file is newer.
|
|
|
|
If DEL-ELC is nil then byte compile files. If DEL-ELC is non-nil
|
|
then instead delete the compiled files."
|
|
;;(directory-files (file-name-directory buffer-file-name) t "\.el\\'")
|
|
(dolist (el-src (directory-files dir t "\.el\\'"))
|
|
(let ((elc-dst (concat el-src "c")))
|
|
(if del-elc
|
|
(when (file-exists-p elc-dst)
|
|
(delete-file elc-dst)
|
|
(message "Deleted %s" elc-dst))
|
|
(setq debug-on-error t)
|
|
(when (or force (file-newer-than-file-p el-src elc-dst))
|
|
;;(message "fn=%s" (file-name-nondirectory el-src))
|
|
(when t ;;(string= "nxhtml-menu.el" (file-name-nondirectory el-src))
|
|
;;(message "(nxhtml-byte-compile-file %s)" el-src)
|
|
(unless (nxhtml-byte-compile-file el-src load)
|
|
(message "Couldn't compile %s" el-src)))))))
|
|
(dolist (f (directory-files dir t))
|
|
(when (file-directory-p f)
|
|
;; Fix-me: Avoid some dirs
|
|
(let ((name (file-name-nondirectory f)))
|
|
(unless (member name nxhtmlmaint-nonbyte-compile-dirs)
|
|
(nxhtmlmaint-byte-compile-dir f force del-elc load))))))
|
|
|
|
(provide 'nxhtmlmaint)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;; nxhtmlmaint.el ends here
|