emacs/nxhtml/nxhtml/html-chklnk.el

   1 ;;; html-chklnk.el --- Check links in local HTML sites
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: Wed Mar 15 14:46:17 2006
   5 (defconst html-chklnk:version "0.2") ;; Version:
   6 ;; Last-Updated: Tue Apr 10 04:12:32 2007 (7200 +0200)
   7 ;; Keywords:
   8 ;; Compatibility:
   9 ;;
  10 ;; Features that might be required by this library:
  11 ;;
  12 ;;   None
  13 ;;
  14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15 ;;
  16 ;;; Commentary:
  17 ;;
  18 ;;
  19 ;;
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21 ;;
  22 ;;; Change log:
  23 ;;
  24 ;;
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;; This program is free software; you can redistribute it and/or modify
  28 ;; it under the terms of the GNU General Public License as published by
  29 ;; the Free Software Foundation; either version 2, or (at your option)
  30 ;; any later version.
  31 ;;
  32 ;; This program is distributed in the hope that it will be useful,
  33 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  34 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35 ;; GNU General Public License for more details.
  36 ;;
  37 ;; You should have received a copy of the GNU General Public License
  38 ;; along with this program; see the file COPYING.  If not, write to the
  39 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  40 ;; Boston, MA 02111-1307, USA.
  41 ;;
  42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 ;;
  44 ;;; Code:
  45
  46 (eval-when-compile (add-to-list 'load-path default-directory load-path))
  47 (eval-when-compile
  48   (when (> emacs-major-version 22)
  49     (let* ((load-path load-path)
  50            (this-file (or load-file-name
  51                           (when (boundp 'bytecomp-filename) bytecomp-filename)
  52                           buffer-file-name))
  53            (this-dir (file-name-directory this-file)))
  54       (add-to-list 'load-path (expand-file-name "../../lisp" this-dir))
  55       (require 'w32shell nil t))))
  56
  57
  58 (eval-when-compile (require 'html-site nil t))
  59 (require 'compile)
  60
  61 ;;;###autoload
  62 (defgroup html-chklnk nil
  63   "Customization group for html-chklnk."
  64   :group 'nxhtml)
  65
  66 (defcustom html-chklnk-dir
  67   (file-name-as-directory
  68    (expand-file-name
  69     "html-chklnk"
  70     (file-name-directory
  71      (if load-file-name load-file-name buffer-file-name))))
  72
  73   "Directory where the tools needed are located.
  74 "
  75   :type 'directory
  76   :group 'html-chklnk)
  77
  78 (defun html-chklnk-check-site-links (start-file)
  79   "Check local file web site links.
  80 Currently only internal links are checked."
  81   (interactive
  82    (progn
  83      (html-site-current-ensure-site-defined)
  84      (if (y-or-n-p "Start from a given file and check links from there? ")
  85          (let* ((default-start (if (html-site-current-contains buffer-file-name)
  86                                    buffer-file-name
  87                                  (car (directory-files (html-site-current-site-dir)
  88                                                        nil
  89                                                        "\\.html?$"))))
  90                 (start-file
  91                  (read-file-name "Start checking from file: "
  92                                  (html-site-current-site-dir)
  93                                  nil
  94                                  nil
  95                                  default-start)))
  96            (unless (html-site-dir-contains (html-site-current-site-dir) start-file)
  97              (error "File %s is not in the site %s" start-file html-site-current))
  98            (list start-file))
  99        (list nil))))
 100   (let* ((default-directory html-chklnk-dir)
 101          (compile-cmd (concat "perl link_checker.pl "
 102                               "--site="
 103                               ;;(html-chklnk-convert-file-name
 104                                (html-site-current-site-dir)
 105                                ;;)
 106                               (if start-file
 107                                   (concat " --start="
 108                                           ;;(html-chklnk-convert-file-name
 109                                            start-file
 110                                            ;;)
 111                                           )
 112                                 "")))
 113          (compilation-buffer-name-function
 114           '(lambda (dummy) (concat "** Checking links in site "
 115                                   html-site-current " **")))
 116          (compilation-scroll-output t)
 117          (compilation-error-regexp-alist-alist
 118           '(
 119             (html-chklnk
 120              "^\\(.*\\)\\s-+at line \\([0-9]+\\):"
 121                1 ;; file
 122                2 ;; line
 123                )))
 124          (compilation-error-regexp-alist '(html-chklnk))
 125          ;;(shell-file-name "cmd")
 126          ;;(explicit-shell-file-name "cmd")
 127          ;;(shell (concat exec-directory "cmdproxy.exe"))
 128          ;;(old-w32shell nil)
 129          )
 130     ;; There are trouble with perl paths
 131 ;;     (when (featurep 'w32shell)
 132 ;;       (when w32shell-current-shell-path
 133 ;;         (setq old-w32shell w32shell-current-shell-path)
 134 ;;         (w32shell-set-shell "cmd")))
 135     ;;(message "uses-cygwin=%s" uses-cygwin)(sit-for 8)
 136
 137     (if (fboundp 'w32shell-save-shell)
 138         (w32shell-save-shell
 139           "cmd"
 140           (compile compile-cmd))
 141       (compile compile-cmd))
 142
 143 ;;     (when old-w32shell
 144 ;;       (cond ((string= old-w32shell w32shell-cygwin-bin)
 145 ;;              (w32shell-set-shell "cygwin"))
 146 ;;             ((string= old-w32shell w32shell-msys-bin)
 147 ;;              (w32shell-set-shell "msys"))))
 148     ))
 149
 150 (defun html-chklnk-convert-file-name (filename)
 151   (let ((uses-cygwin (and (featurep 'w32shell)
 152                           (string= w32shell-current-shell-path
 153                                    w32shell-cygwin-bin)))
 154         (case-fold-search t)
 155         )
 156     (save-match-data
 157       (if (and uses-cygwin
 158                (string-match "^\\([a-z]\\):" filename))
 159           (concat "/cygdrive/" (match-string 1 filename)
 160                   (substring filename 2))
 161         filename))))
 162
 163
 164
 165
 166 (provide 'html-chklnk)
 167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 168 ;;; html-chklnk.el ends here