path: root/emacs.d/nxhtml/nxhtmlmaint.el

;;; 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