nxhtml/nxhtmlmaint.el

   1 ;;; nxhtmlmaint.el --- Some maintenance helpers
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2008-09-27T15:29:35+0200 Sat
   5 ;; Version: 0.6
   6 ;; Last-Updated: 2010-01-18 Mon
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; This module contains maintenance functions:
  20 ;;
  21 ;; `nxhtmlmaint-get-all-autoloads' (nxhtmlmaint-get-all-autoloads)
  22 ;;
  23 ;; `nxhtmlmaint-start-byte-compilation'
  24 ;; `nxhtmlmaint-byte-uncompile-all'
  25 ;;
  26 ;;
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;;
  29 ;;; Change log:
  30 ;;
  31 ;;
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33 ;;
  34 ;; This program is free software; you can redistribute it and/or
  35 ;; modify it under the terms of the GNU General Public License as
  36 ;; published by the Free Software Foundation; either version 2, or
  37 ;; (at your option) any later version.
  38 ;;
  39 ;; This program is distributed in the hope that it will be useful,
  40 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  41 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  42 ;; General Public License for more details.
  43 ;;
  44 ;; You should have received a copy of the GNU General Public License
  45 ;; along with this program; see the file COPYING.  If not, write to
  46 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  47 ;; Floor, Boston, MA 02110-1301, USA.
  48 ;;
  49 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50 ;;
  51 ;;; Code:
  52
  53 (eval-when-compile (require 'advice))
  54 (eval-when-compile (require 'nxhtml-base))
  55 (eval-when-compile (require 'nxhtml-web-vcs nil t))
  56 (eval-when-compile (require 'web-vcs nil t))
  57 (eval-when-compile (require 'ourcomments-util))
  58
  59 (defvar nxhtmlmaint-dir
  60   ;;(file-name-directory (if load-file-name load-file-name buffer-file-name))
  61   (file-name-directory (or load-file-name
  62                            (when (boundp 'bytecomp-filename) bytecomp-filename)
  63                            buffer-file-name))
  64   "Maintenance directory for nXhtml.")
  65
  66 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67 ;;;; Autoload helpers
  68
  69 (defun nxhtmlmaint-autoloads-file ()
  70   "Return autoload file name for nXhtml."
  71   (file-truename (expand-file-name "nxhtml-loaddefs.el" nxhtmlmaint-dir)))
  72
  73 (defun nxhtmlmaint-util-dir ()
  74   "Return nXhtml util directory."
  75   (file-truename (file-name-as-directory
  76                   (expand-file-name "util" nxhtmlmaint-dir))))
  77
  78 (defvar nxhtmlmaint-autoload-default-directory (nxhtmlmaint-util-dir))
  79
  80 (defvar generated-autoload-file)
  81
  82 (defun nxhtmlmaint-initialize-autoloads-file ()
  83   "Initialize nXhtml autoload file."
  84   (with-current-buffer (find-file-noselect generated-autoload-file)
  85     (when (= 0 (buffer-size))
  86       (insert ";; Autoloads for nXthml
  87 ;;
  88 ;; This file should be updated by `nxhtmlmaint-get-file-autoloads',
  89 ;; `nxhtmlmaint-get-dir-autoloads' or `nxhtmlmaint-get-all-autoloads'.
  90 \(eval-when-compile (require 'nxhtml-base))
  91 \(eval-when-compile (require 'web-vcs))")
  92     (basic-save-buffer))))
  93
  94 (defun nxmtmlmaint-advice-autoload (on)
  95   "Activate advices if ON, otherwise turn them off."
  96   (if on
  97       (progn
  98         (ad-activate 'autoload-file-load-name)
  99         (ad-activate 'make-autoload))
 100     (ad-deactivate 'autoload-file-load-name)
 101     (ad-deactivate 'make-autoload)))
 102
 103 (defun nxhtmlmaint-get-file-autoloads (file)
 104   "Get autoloads for file FILE.
 105 Update nXhtml autoload file with them."
 106   (interactive (list (buffer-file-name)))
 107   (let* ((generated-autoload-file (nxhtmlmaint-autoloads-file))
 108          (emacs-lisp-mode-hook nil)
 109          (default-directory (nxhtmlmaint-util-dir)))
 110     (nxhtmlmaint-initialize-autoloads-file)
 111     ;; Get the autoloads using advice
 112     (nxmtmlmaint-advice-autoload t)
 113     (update-file-autoloads file nil)
 114     (nxmtmlmaint-advice-autoload nil)
 115     ;; Display
 116     (display-buffer (find-file-noselect generated-autoload-file))))
 117
 118 (defun nxhtmlmaint-get-dir-autoloads (dir)
 119   "Get autoloads for directory DIR.
 120 Update nXhtml autoload file with them."
 121   (interactive (list (or (when (buffer-file-name)
 122                            (file-name-directory (buffer-file-name)))
 123                          default-directory)))
 124   (let* ((generated-autoload-file (nxhtmlmaint-autoloads-file))
 125          (emacs-lisp-mode-hook nil)
 126          (auto-buf (find-file-noselect generated-autoload-file)))
 127     (nxhtmlmaint-initialize-autoloads-file)
 128     ;; Get the autoloads using advice
 129     (nxmtmlmaint-advice-autoload t)
 130     ;; Fix-me: Loop instead, some files must be avoided.
 131     (update-directory-autoloads dir)
 132     (nxmtmlmaint-advice-autoload nil)
 133     ;; Display
 134     (display-buffer (find-file-noselect generated-autoload-file))))
 135
 136 (defun nxhtmlmaint-get-tree-autoloads (root)
 137   "Get autoloads for directory tree ROOT.
 138 Update nXhtml autoload file with them."
 139   (interactive (list (or (when (buffer-file-name)
 140                            (file-name-directory (buffer-file-name)))
 141                          default-directory)))
 142   (message "Getting autoloads in %s" root)
 143   (nxhtmlmaint-get-dir-autoloads root)
 144   (let* ((files (directory-files root))
 145          (sub-dirs (mapcar (lambda (file)
 146                              (when (and (not (member file '("." "..")))
 147                                         (not (member file '("nxml-mode-20041004" "old")))
 148                                         (not (member file '("nxhtml-company-mode")))
 149                                         (not (member file '("in")))
 150                                         (file-directory-p (expand-file-name file root)))
 151                                file))
 152                            files)))
 153     (setq sub-dirs (delq nil sub-dirs))
 154     ;;(message "sub-dirs=%s" sub-dirs)
 155     (dolist (dir sub-dirs)
 156       (let ((full-dir (expand-file-name dir root)))
 157         (unless (or (string= full-dir nxhtmlmaint-dir)
 158                     (string= dir "alts"))
 159           (nxhtmlmaint-get-tree-autoloads full-dir))))))
 160
 161 ;;(nxhtmlmaint-get-all-autoloads)
 162 (defun nxhtmlmaint-get-all-autoloads ()
 163   "Get all autoloads for nXhtml.
 164 Update nXhtml autoload file with them."
 165   ;;(interactive)
 166   (if nxhtml-autoload-web
 167       (message "Skipping rebuilding autoloads, not possible when autoloading from web")
 168     (let ((auto-buf (find-file-noselect (nxhtmlmaint-autoloads-file))))
 169       (with-current-buffer auto-buf
 170         (erase-buffer)
 171         (basic-save-buffer))
 172       (nxhtmlmaint-get-tree-autoloads nxhtmlmaint-dir)
 173       ;; `nxhtml-mode' and `nxhtml-validation-header-mode' should only be
 174       ;; autoloaded if nxml-mode if available.
 175       (with-current-buffer auto-buf
 176         (message "Fixing nxml autoloads")
 177         (let ((frmt (if (= emacs-major-version 22)
 178                         "^(autoload (quote %s) "
 179                       "^(autoload '%s ")))
 180           (dolist (nxmode '(nxhtml-mode nxhtml-validation-header-mode))
 181             (goto-char (point-min))
 182             (when (re-search-forward (format frmt nxmode) nil t)
 183               (forward-line 0)
 184               (insert "(when (fboundp 'nxml-mode)\n")
 185               (forward-sexp)
 186               (insert ")"))))
 187         ;; Fix defcustom autoloads
 188         (goto-char (point-min))
 189         (let ((cus-auto "(\\(custom-autoload\\) +'.* +\\(\".*?\"\\)"))
 190           (while (re-search-forward cus-auto nil t)
 191             ;;(backward-char (1- (length cus-auto)))
 192             ;;(insert "nxhtml-")
 193             (let ((lib (match-string 2)))
 194               ;; Change to symbol to fix autoloading. This works because
 195               ;; custom-load-symbol does require on symbols.
 196               (setq lib (concat "'" (substring lib 1 -1)))
 197               (replace-match "nxhtml-custom-autoload" t t nil 1)
 198               (replace-match lib t t nil 2))))
 199         ;; Fix autoload calls
 200         (goto-char (point-min))
 201         (let ((auto "(autoload "))
 202           (while (search-forward auto nil t)
 203             (backward-char (1- (length auto)))
 204             (insert "nxhtml-")))
 205         ;; Fix autoload source
 206         (goto-char (point-min))
 207         (let* ((patt-src "^;;; Generated autoloads from \\(.*\\)$")
 208                (patt-auto "^(nxhtml-autoload '[^ ]+ \\(\"[^\"]+\"\\)")
 209                (patt-cust "^(nxhtml-custom-autoload '[^ ]+ \\(\"[^\"]+\"\\)")
 210                (patt (concat "\\(?:" patt-src "\\)\\|\\(?:" patt-auto "\\)\\|\\(?:" patt-cust "\\)"))
 211                curr-src)
 212           (while (re-search-forward patt nil t)
 213             (cond
 214              ( (match-string 1)
 215                (setq curr-src (match-string-no-properties 1))
 216                ;; Remove .el
 217                (setq curr-src (substring curr-src 0 -3))
 218                ;; Setup up for web autoload
 219                (let* ((src-name (file-name-nondirectory curr-src))
 220                       (feature (make-symbol src-name))
 221                       )
 222                  (end-of-line)
 223                  (insert "\n"
 224                          "(web-autoload-require '"
 225                          (symbol-name feature)
 226                          " 'lp"
 227                          " '(nxhtml-download-root-url nil)"
 228                          " \"" curr-src "\""
 229                          " nxhtml-install-dir"
 230                          " 'nxhtml-byte-compile-file"
 231                          ")\n"))
 232                )
 233              ( (match-string 3)
 234                ;; (custom-autoload 'sym "lib" nil) is will give a
 235                ;; (require 'lib) so everything is ok here.
 236                nil)
 237              ( (or (match-string 2)
 238                    (match-string 3)
 239                    )
 240                (let* ((subexp (if (match-string 2) 2 3))
 241                       (file (match-string-no-properties subexp)))
 242                  (replace-match (concat "`(lp '(nxhtml-download-root-url nil)"
 243                                         " \"" curr-src "\""
 244                                         " nxhtml-install-dir)")
 245                                 nil ;; fixedcase
 246                                 nil ;; literal
 247                                 nil ;; string
 248                                 subexp   ;; subexp
 249                                 ))
 250                )
 251              (t (error "No match???")))))
 252         ;; Save
 253         (basic-save-buffer)))))
 254
 255
 256 (defun nxhtmlmaint-autoload-file-load-name (file)
 257   "Return relative file name for FILE to autoload file directory."
 258   (let ((name (if (and nxhtmlmaint-autoload-default-directory
 259                        (file-name-absolute-p file))
 260                   (file-relative-name
 261                    file nxhtmlmaint-autoload-default-directory)
 262                 (file-name-nondirectory file))))
 263     (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
 264         (substring name 0 (match-beginning 0))
 265       name)))
 266
 267 (defadvice autoload-file-load-name (around
 268                                     nxhtmlmaint-advice-autoload-file-load-name
 269                                     ;;activate
 270                                     compile)
 271   "Advice to return relative file name."
 272   (setq ad-return-value (nxhtmlmaint-autoload-file-load-name (ad-get-arg 0))))
 273
 274 (defun nxhtmlmaint-make-autoload (form file)
 275   "Make autoload for multi major modes."
 276   ;;(message "form=%S" form)
 277   (if (or (not (listp form))
 278           (not (eq 'define-mumamo-multi-major-mode (car form))))
 279       ad-return-value
 280     (if ad-return-value
 281         ad-return-value
 282       ;; Fix-me: Maybe expand??
 283       (let ((name (nth 1 form))
 284             (doc  (nth 2 form)))
 285         `(autoload ',name ,file ,doc t)
 286         ))))
 287
 288 (defadvice make-autoload (after
 289                           nxhtmlmaint-advice-make-autoload
 290                           ;;activate
 291                           compile)
 292   "Make autoload for multi major modes."
 293   (setq ad-return-value
 294         (nxhtmlmaint-make-autoload (ad-get-arg 0)
 295                                    (ad-get-arg 1))))
 296
 297 ;; (defun nxhtmlmaint-generate-library-autoloads (library)
 298 ;;   "Insert at point autoloads for Emacs library LIBRARY.
 299 ;;   Works like `generate-file-autoloads', but for a library."
 300 ;;   (interactive
 301 ;;    (list (completing-read "Generate autoloads for library: "
 302 ;;                           'locate-file-completion
 303 ;;                           (cons load-path (get-load-suffixes)))))
 304 ;;   (let ((file (locate-library library)))
 305 ;;     ;; Fix-me: wasn't this defined???
 306 ;;     (generate-file-autoloads file)))
 307
 308 ;;;###autoload
 309 (defun nxhtmlmaint-start-byte-compilation ()
 310   "Start byte compilation of nXhtml in new Emacs instance.
 311 Byte compiling in general makes elisp code run 5-10 times faster
 312 which is quite noticeable when you use nXhtml.
 313
 314 This will also update the file nxhtml-loaddefs.el.
 315
 316 You must restart Emacs to use the byte compiled files.
 317
 318 If for some reason the byte compiled files does not work you can
 319 remove then with `nxhtmlmaint-byte-uncompile-all'."
 320   (interactive)
 321   ;; Fix-me: This message and redisplay seems only necessary sometimes.
 322   (message "Preparing byte compilation of nXhtml ...") (redisplay t)
 323   (let* ((this-file    (expand-file-name "nxhtmlmaint.el" nxhtmlmaint-dir))
 324          (auto-file    (expand-file-name "autostart.el" nxhtmlmaint-dir))
 325          (web-vcs-file (expand-file-name "nxhtml-web-vcs.el" nxhtmlmaint-dir))
 326          (this-emacs (locate-file invocation-name
 327                                   (list invocation-directory)
 328                                   exec-suffixes))
 329          (process-args `(,this-emacs nil 0 nil "-Q")))
 330     (nxhtmlmaint-byte-uncompile-all)
 331     (if (or noninteractive
 332             (not window-system))
 333         (nxhtmlmaint-byte-compile-all)
 334       ;;(when noninteractive (setq process-args (append process-args '("-batch"))))
 335       (setq process-args (append process-args
 336                                  (list "-l" auto-file
 337                                        "-l" web-vcs-file
 338                                        "-l" this-file
 339                                        "-f" "nxhtmlmaint-byte-compile-all")))
 340       (message "process-args=%S" process-args)
 341       (message "Starting new Emacs instance for byte compiling ...")
 342       (apply 'call-process process-args))))
 343
 344 ;;(nxhtmlmaint-byte-compile-all)
 345 (defun nxhtmlmaint-byte-compile-all ()
 346   "Byte recompile all files in nXhtml that needs it."
 347   (message "nxhtmlmaint-byte-compile-all: nxhtmlmaint-dir=%S, exists=%s" nxhtmlmaint-dir (file-directory-p nxhtmlmaint-dir))
 348   (let* ((load-path load-path)
 349          (nxhtml-dir (file-name-as-directory
 350                       (expand-file-name "nxhtml"
 351                                         nxhtmlmaint-dir)))
 352          (util-dir (file-name-as-directory
 353                     (expand-file-name "util"
 354                                       nxhtmlmaint-dir)))
 355          ;; (nxhtml-company-dir (file-name-as-directory
 356          ;;                      (expand-file-name "nxhtml-company-mode"
 357          ;;                                        util-dir)))
 358          (related-dir (file-name-as-directory
 359                        (expand-file-name "related"
 360                                          nxhtmlmaint-dir)))
 361          (tests-dir (file-name-as-directory
 362                      (expand-file-name "tests"
 363                                        nxhtmlmaint-dir)))
 364          (emacsw32-dir (file-name-as-directory
 365                         (expand-file-name "../lisp"
 366                                           nxhtmlmaint-dir)))
 367          (default-dir nxhtml-dir)
 368          )
 369     (message "nxhtmlmaint-byte-compile-all: nxhtml-dir=%S, exists=%s" nxhtml-dir (file-directory-p nxhtml-dir))
 370     (message "nxhtmlmaint-byte-compile-all: util-dir=%S, exists=%s" util-dir (file-directory-p util-dir))
 371     (message "nxhtmlmaint-byte-compile-all: related-dir=%S, exists=%s" related-dir (file-directory-p related-dir))
 372     (message "nxhtmlmaint-byte-compile-all: tests-dir=%S, exists=%s" tests-dir (file-directory-p tests-dir))
 373     (add-to-list 'load-path nxhtml-dir)
 374     (add-to-list 'load-path util-dir)
 375     ;;(add-to-list 'load-path nxhtml-company-dir)
 376     (add-to-list 'load-path related-dir)
 377     (add-to-list 'load-path tests-dir)
 378     (when (file-directory-p emacsw32-dir)
 379       (add-to-list 'load-path emacsw32-dir))
 380     (require 'cl) ;; This is run in a new Emacs. Fix-me: This might not be true any more.
 381     (message "load-path=%s" load-path)
 382     (let ((dummy-debug-on-error t))
 383       (nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir nil nil nil))
 384     (web-vcs-message-with-face 'web-vcs-gold "Byte compiling nXhtml is ready, restart Emacs to use the compiled files")))
 385
 386 ;;;###autoload
 387 (defun nxhtmlmaint-byte-recompile ()
 388   "Recompile or compile all nXhtml files in current Emacs."
 389   (interactive)
 390   (nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir nil nil t)
 391   (web-vcs-message-with-face 'web-vcs-gold "Byte recompiling nXhtml ready"))
 392
 393 ;;;###autoload
 394 (defun nxhtmlmaint-byte-uncompile-all ()
 395   "Delete byte compiled files in nXhtml.
 396 This will also update the file nxhtml-loaddefs.el.
 397
 398 See `nxhtmlmaint-start-byte-compilation' for byte compiling."
 399   (interactive)
 400   (nxhtmlmaint-get-all-autoloads)
 401   (let ((dummy-debug-on-error t))
 402     (nxhtmlmaint-byte-compile-dir nxhtmlmaint-dir t t nil))
 403   (message "Byte uncompiling is ready, restart Emacs to use the elisp files"))
 404
 405 (defconst nxhtmlmaint-nonbyte-compile-dirs
 406   '("." ".." "alts" "nxml-mode-20041004" "old" "tests" "nxhtml-company-mode"))
 407
 408 ;; Fix-me: simplify this now that nxml is not included
 409 (defun nxhtmlmaint-byte-compile-dir (dir force del-elc load)
 410   "Byte compile or uncompile directory tree DIR.
 411 If FORCE is non-nil byte recompile the elisp file even if the
 412 compiled file is newer.
 413
 414 If DEL-ELC is nil then byte compile files.  If DEL-ELC is non-nil
 415 then instead delete the compiled files."
 416   ;;(directory-files (file-name-directory buffer-file-name) t "\.el\\'")
 417   (dolist (el-src (directory-files dir t "\.el\\'"))
 418     (let ((elc-dst (concat el-src "c")))
 419       (if del-elc
 420           (when (file-exists-p elc-dst)
 421             (delete-file elc-dst)
 422             (message "Deleted %s" elc-dst))
 423         (setq debug-on-error t)
 424         (when (or force (file-newer-than-file-p el-src elc-dst))
 425           ;;(message "fn=%s" (file-name-nondirectory el-src))
 426           (when t ;;(string= "nxhtml-menu.el" (file-name-nondirectory el-src))
 427             ;;(message "(nxhtml-byte-compile-file %s)" el-src)
 428             (unless (nxhtml-byte-compile-file el-src load)
 429               (message "Couldn't compile %s" el-src)))))))
 430   (dolist (f (directory-files dir t))
 431     (when (file-directory-p f)
 432       ;; Fix-me: Avoid some dirs
 433       (let ((name (file-name-nondirectory f)))
 434         (unless (member name nxhtmlmaint-nonbyte-compile-dirs)
 435           (nxhtmlmaint-byte-compile-dir f force del-elc load))))))
 436
 437 (provide 'nxhtmlmaint)
 438 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 439 ;;; nxhtmlmaint.el ends here