;;; html-chklnk.el --- Check links in local HTML sites
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: Wed Mar 15 14:46:17 2006
(defconst html-chklnk:version "0.2") ;; Version:
;; Last-Updated: Tue Apr 10 04:12:32 2007 (7200 +0200)
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (add-to-list 'load-path default-directory load-path))
(eval-when-compile
(when (> emacs-major-version 22)
(let* ((load-path load-path)
(this-file (or load-file-name
(when (boundp 'bytecomp-filename) bytecomp-filename)
buffer-file-name))
(this-dir (file-name-directory this-file)))
(add-to-list 'load-path (expand-file-name "../../lisp" this-dir))
(require 'w32shell nil t))))
(eval-when-compile (require 'html-site nil t))
(require 'compile)
;;;###autoload
(defgroup html-chklnk nil
"Customization group for html-chklnk."
:group 'nxhtml)
(defcustom html-chklnk-dir
(file-name-as-directory
(expand-file-name
"html-chklnk"
(file-name-directory
(if load-file-name load-file-name buffer-file-name))))
"Directory where the tools needed are located.
"
:type 'directory
:group 'html-chklnk)
(defun html-chklnk-check-site-links (start-file)
"Check local file web site links.
Currently only internal links are checked."
(interactive
(progn
(html-site-current-ensure-site-defined)
(if (y-or-n-p "Start from a given file and check links from there? ")
(let* ((default-start (if (html-site-current-contains buffer-file-name)
buffer-file-name
(car (directory-files (html-site-current-site-dir)
nil
"\\.html?$"))))
(start-file
(read-file-name "Start checking from file: "
(html-site-current-site-dir)
nil
nil
default-start)))
(unless (html-site-dir-contains (html-site-current-site-dir) start-file)
(error "File %s is not in the site %s" start-file html-site-current))
(list start-file))
(list nil))))
(let* ((default-directory html-chklnk-dir)
(compile-cmd (concat "perl link_checker.pl "
"--site="
;;(html-chklnk-convert-file-name
(html-site-current-site-dir)
;;)
(if start-file
(concat " --start="
;;(html-chklnk-convert-file-name
start-file
;;)
)
"")))
(compilation-buffer-name-function
'(lambda (dummy) (concat "** Checking links in site "
html-site-current " **")))
(compilation-scroll-output t)
(compilation-error-regexp-alist-alist
'(
(html-chklnk
"^\\(.*\\)\\s-+at line \\([0-9]+\\):"
1 ;; file
2 ;; line
)))
(compilation-error-regexp-alist '(html-chklnk))
;;(shell-file-name "cmd")
;;(explicit-shell-file-name "cmd")
;;(shell (concat exec-directory "cmdproxy.exe"))
;;(old-w32shell nil)
)
;; There are trouble with perl paths
;; (when (featurep 'w32shell)
;; (when w32shell-current-shell-path
;; (setq old-w32shell w32shell-current-shell-path)
;; (w32shell-set-shell "cmd")))
;;(message "uses-cygwin=%s" uses-cygwin)(sit-for 8)
(if (fboundp 'w32shell-save-shell)
(w32shell-save-shell
"cmd"
(compile compile-cmd))
(compile compile-cmd))
;; (when old-w32shell
;; (cond ((string= old-w32shell w32shell-cygwin-bin)
;; (w32shell-set-shell "cygwin"))
;; ((string= old-w32shell w32shell-msys-bin)
;; (w32shell-set-shell "msys"))))
))
(defun html-chklnk-convert-file-name (filename)
(let ((uses-cygwin (and (featurep 'w32shell)
(string= w32shell-current-shell-path
w32shell-cygwin-bin)))
(case-fold-search t)
)
(save-match-data
(if (and uses-cygwin
(string-match "^\\([a-z]\\):" filename))
(concat "/cygdrive/" (match-string 1 filename)
(substring filename 2))
filename))))
(provide 'html-chklnk)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; html-chklnk.el ends here