;;;; misc-patchup.el -- various mending of pages
;;; Time-stamp: <2004-11-20 12:06:30 jcgs>
;; 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 of the License, 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; if not, write to the Free Software Foundation, Inc.,
;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(provide 'misc-patchup)
(require 'webmaster-macros)
(defun ensure-page-has-html ()
"Ensure the page has html markers."
(interactive)
(webmaster:throughout-buffer
(unless (search-forward "" (point-max) t)
(goto-char (point-min))
(insert "\n")))
(webmaster:throughout-buffer
(unless (search-forward "" (point-max) t)
(goto-char (point-max))
(insert "\n\n"))))
(defun ensure-page-has-head ()
"Ensure the page has a head."
(interactive)
(ensure-page-has-html)
(webmaster:throughout-buffer
(unless (search-forward "
" (point-max) 1)
(search-backward "")
(insert "\n")))
(webmaster:throughout-buffer
(unless (search-forward "" (point-max) 1)
(search-backward "")
(insert "\n"))))
(defun html-match-heading ()
"Set the match data to the first match for a heading.
Returns the result of the re-search-forward that succeeded."
(let ((case-fold-search t))
(cond
((save-excursion (re-search-forward "\\(.+\\)" (point-max) t)))
((save-excursion (re-search-forward "\\(.+\\)" (point-max) t)))
((save-excursion (re-search-forward "\\(.+\\)" (point-max) t)))
((save-excursion (re-search-forward "\\(.+\\)" (point-max) t)))
((save-excursion (re-search-forward "\\(.+\\)" (point-max) t)))
((save-excursion (re-search-forward "\\(.+\\)" (point-max) t)))
(t nil))))
(defun guess-page-title ()
"Guess a title for this page."
(webmaster:throughout-buffer
(cond
((html-match-heading)
(match-string 1))
((save-excursion
(re-search-forward "" (point-max) t))
(match-string 1))
(t (buffer-name)))))
(defun guess-page-title ()
"Guess a title for this page."
(webmaster:throughout-buffer
(cond
((html-match-heading)
(match-string 1))
((save-excursion
(re-search-forward "" (point-max) t))
(match-string 1))
(t (buffer-name)))))
(defun ensure-page-has-title ()
"Ensure this page has a title, using the heading if necessary and possible."
(interactive)
(ensure-page-has-head)
(webmaster:throughout-buffer (delete-matching-lines "^AceDB $"))
(webmaster:throughout-buffer
(unless (re-search-forward "" (point-max) t)
(goto-char (point-max))
(search-backward "")
(insert "\n" (guess-page-title) "\n"))))
(defun ensure-tree-has-titles (tree)
"Ensure that all pages in TREE have titles."
(interactive "DTree: ")
(webmaster:apply-throughout-tree tree 'ensure-page-has-title nil nil))
(defun make-symbolic-linkd (filename linkname)
"dummy"
(message "Making link %s to file %s" linkname filename))
(defun symlink-files-in-directories (files directories)
"Make a symlink to each of FILES in each of DIRECTORIES."
(let* ((filepairs (mapcar (function
(lambda (file)
(cons (file-name-nondirectory file)
(expand-file-name file))))
files))
(fulldirs (mapcar 'expand-file-name directories)))
(dolist (dir fulldirs)
(dolist (filepair filepairs)
(make-symbolic-link
(cdr filepair)
(expand-file-name (car filepair) dir)
t)))))
$COMMON
;;; end of misc-patchup.el