diff options
Diffstat (limited to 'emacs.d/nxhtml/nxhtmlmaint.el')
| -rw-r--r-- | emacs.d/nxhtml/nxhtmlmaint.el | 439 |
1 files changed, 439 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/nxhtmlmaint.el b/emacs.d/nxhtml/nxhtmlmaint.el new file mode 100644 index 0000000..68c03b7 --- /dev/null +++ b/emacs.d/nxhtml/nxhtmlmaint.el @@ -0,0 +1,439 @@ +;;; 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 |