1 ;;; html-site.el --- Keeping (X)HTML files together
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: Wed Mar 01 17:25:52 2006
5 (defconst html-site:version "0.3");; Version:
6 ;; Last-Updated: 2008-03-22T03:32:06+0100 Sat
10 ;; Features that might be required by this library:
12 ;; `cl', `html-site', `html-upl', `ietf-drums', `mail-parse',
13 ;; `mail-prsvr', `mailcap', `mm-util', `qp', `rfc2045', `rfc2047',
14 ;; `rfc2231', `time-date', `timer', `timezone', `tls', `url',
15 ;; `url-auth', `url-c', `url-cookie', `url-expand', `url-gw',
16 ;; `url-history', `url-http', `url-methods', `url-parse',
17 ;; `url-privacy', `url-proxy', `url-util', `url-vars'.
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 ;; This program is free software; you can redistribute it and/or modify
33 ;; it under the terms of the GNU General Public License as published by
34 ;; the Free Software Foundation; either version 2, or (at your option)
37 ;; This program is distributed in the hope that it will be useful,
38 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
39 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
40 ;; GNU General Public License for more details.
42 ;; You should have received a copy of the GNU General Public License
43 ;; along with this program; see the file COPYING. If not, write to the
44 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
45 ;; Boston, MA 02111-1307, USA.
47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 ;; TODO: maybe use browse-url-filename-alist
53 (eval-when-compile (require 'cl))
54 (eval-when-compile (require 'compile))
55 (eval-when-compile (require 'dired))
56 (eval-when-compile (require 'ffip nil t))
57 (eval-when-compile (require 'grep))
58 (eval-when-compile (require 'ourcomments-util nil t))
59 (eval-when-compile (require 'url-parse))
60 ;;(defvar html-site-list) ;; Silence compiler
61 ;;(defvar html-site-current) ;; Silence compiler
64 (defgroup html-site nil
65 "Customization group for html-site."
68 ;; Fix-me: Rewrite using directory variables
69 (defcustom html-site-list nil
70 "Known site directories and corresponding attributes.
71 Each element in the list is a list containing:
74 * Site root directory.
75 * Page list file - Pages for table of contents (TOC). Usually
76 initially built from the site directory by
77 `html-toc-create-pages-file'.
79 * TOC file for the frames file.
80 * Output directory - where to put the merged TOC and site
82 * Output template file - html template for merging. See `html-wtoc-dir'
84 * Function for additional tasks - for example copying images, style
90 (string :tag "*** Site name ***")
91 (directory :tag "Site root directory")
92 (file :tag "Page list file")
93 (file :tag "Frames file")
94 (file :tag "Contents file for frames")
95 (directory :tag "Output directory for pages with TOC" :help-echo "Where to put the merged files")
96 (file :tag "Template file for pages with TOC" :help-echo "HTML template for merging")
97 (choice :tag "Extra function for pages with TOC"
98 (const nil :tag "Default function")
101 (string :tag "Ftp host address")
102 (string :tag "Ftp user")
103 (string :tag "Ftp password")
104 (string :tag "Ftp directory root")
105 (string :tag "Ftp directory root for pages with TOC")
106 (string :tag "Web host address")
107 (string :tag "Web directory root")
108 (string :tag "Web directory root for pages with TOC")
110 :set (lambda (symbol value)
111 ;;(message "sym=%s, value=%s" symbol value)
112 (set-default symbol value)
113 (when (featurep 'html-site)
129 (ftp-wtoc-dir (elt e 12))
130 (web-host (elt e 13))
132 (web-wtoc-dir (elt e 15))
134 (unless (not (string= "" name))
135 (html-site-lwarn '(html-site-list) :error "Empty site name"))
136 (if (not (file-directory-p site-dir))
138 (html-site-lwarn '(html-site-list) :error "Site directory for %s not found: %s" name site-dir)
140 (unless (file-exists-p pag-file)
141 (html-site-lwarn '(html-site-list) :warning "Pages list file for %s does not exist: %s" name pag-file))
142 (unless (file-exists-p tpl-file)
143 (html-site-lwarn '(html-site-list) :warning "Template file for %s does not exist: %s" name tpl-file)))
144 (when (< 0 (length out-dir))
145 (html-site-chk-wtocdir out-dir site-dir))
147 (unless (functionp fun)
148 (html-site-lwarn '(html-site-list) :error "Site %s - Unknown function: %s" name fun)
155 (defcustom html-site-current ""
157 Use the entry with this name in `html-site-list'."
158 :set (lambda (symbol value)
159 ;;(message "sym=%s, value=%s" symbol value)
160 (set-default symbol value)
161 (when (featurep 'html-site)
162 (or (when (= 0 (length value))
163 (message "html-site-current (information): No current site set"))
165 (dolist (m html-site-list)
166 (setq site-names (cons (elt m 0) site-names)))
168 (unless (member value site-names)
169 (html-site-lwarn '(html-site-current) :error "Can't find site: %s" value))
170 (let ((site-dir (html-site-site-dir value)))
171 (unless (file-directory-p site-dir)
172 (html-site-lwarn '(html-site-current) :error "Can't find site directory: %s" value))))))))
174 :set-after '(html-site-list)
177 (defun html-site-looks-like-local-url (file)
178 "Return t if this looks like a local file something url."
180 (let ((url-type (url-type (url-generic-parse-url file))))
183 ;; Test if it really is an url, the is 1 for w32 drive
185 (or (not (memq system-type '(ms-dos windows-nt)))
186 (< 1 (length url-type)))))))
189 (assert (not (html-site-looks-like-local-url "http://www.some.where/")))
190 (assert (html-site-looks-like-local-url "/unix/file"))
191 (when (memq system-type '(windows-nt))
192 (assert (html-site-looks-like-local-url "c:/w32/file"))))
194 (defun html-site-dir-contains (dir file)
195 ;;(when (= ?~ (string-to-char file)) (setq file (expand-file-name file)))
197 ;; It is not possible to unconditionally expand the file name here
198 ;; since url file names can be involved.
199 ;; (url-type (url-generic-parse-url "c:/some/file.txt"))
200 (let* ((file-is-local (html-site-looks-like-local-url file))
201 (dir-is-local (html-site-looks-like-local-url dir))
202 (file-is-dir (and file-is-local
203 (file-directory-p file)))
204 (true-f (if file-is-local
206 (file-name-as-directory
208 (expand-file-name file)))
210 (expand-file-name file)))
212 ;; (file-name-as-directory (expand-file-name "~/"))
213 (true-d (if dir-is-local
214 (file-name-as-directory
216 (expand-file-name dir)))
217 (if (eq ?/ (car (reverse (append dir nil))))
220 (assert (eq file-is-local dir-is-local))
221 (if (< (length true-d) (length true-f))
223 (substring true-f 0 (length true-d)))
225 (string= true-d true-f)))))
227 (defun html-site-lwarn (warn-type level format-string &rest args)
228 (apply 'message (concat "%s:" format-string) warn-type args)
229 (apply 'lwarn warn-type level args))
231 (defun html-site-chk-wtocdir (out-dir site-dir)
233 (unless (file-name-absolute-p out-dir)
234 (html-site-lwarn '(html-site) :error "Output directory is not absolute: %s" out-dir))
235 (if (file-exists-p out-dir)
236 (unless (file-directory-p out-dir)
237 (html-site-lwarn '(html-site) :error "File %s for output exists but is not a directory" out-dir))
238 (unless (string= out-dir (file-name-as-directory out-dir))
239 (html-site-lwarn '(html-site) :error "File name could not be a directory: %s" out-dir)))
240 (when (html-site-dir-contains out-dir site-dir)
241 (html-site-lwarn '(html-site) :error "Ouput directory for pages with TOC must not contain site dir."))
242 (when (html-site-dir-contains site-dir out-dir)
243 (html-site-lwarn '(html-site) :error "Site dir must not contain ouput directory for pages with TOC."))))
247 (defun html-site-buffer-or-dired-file-name ()
248 "Return buffer file name or file pointed to in dired."
249 (if (derived-mode-p 'dired-mode)
250 (dired-get-file-for-visit)
254 (defun html-site-set-site (name)
257 (must-contain (when (boundp 'must-contain) must-contain))
258 (file (html-site-buffer-or-dired-file-name))
259 (use-dialog-box nil))
260 (unless (< 0 (length html-site-list))
261 (error "No sites defined yet"))
263 ;;(string-match "ml" (symbol-name major-mode))
265 (when (or must-contain
266 (y-or-n-p "Should site contain current file? "))
267 (setq must-contain file)))
268 (dolist (m html-site-list)
269 (let* ((name (elt m 0))
270 (dir (html-site-site-dir name)))
271 (when (or (not must-contain)
272 (html-site-dir-contains dir file))
273 (setq site-names (cons name site-names)))))
276 (error "No sites contains %s" must-contain)))
277 (list (when site-names
278 (let ((prompt (if (< 0 (length html-site-current))
279 (concat "Current site is \""
283 "New site containing file: "
284 "New site's name: "))
286 "Site containing file: "
288 (completing-read prompt site-names nil t nil 'site-names))))))
289 (unless (or (string= name "")
290 (string= name html-site-current))
291 (setq html-site-current name)
292 (customize-save-variable 'html-site-current html-site-current)))
295 (defun html-site-dired-current ()
296 "Open `dired' in current site top directory."
298 (dired (html-site-current-site-dir)))
301 (defun html-site-find-file ()
302 "Find file in current site."
305 (ffip-set-current-project html-site-current
306 (html-site-current-site-dir)
308 (call-interactively 'ffip-find-file-in-project))
311 (defun html-site-rgrep (regexp files)
312 "Search current site's files with `rgrep'.
313 See `rgrep' for the arguments REGEXP and FILES."
316 (grep-compute-defaults)
317 (let* ((regexp (grep-read-regexp))
318 (files (grep-read-files regexp)))
319 (list regexp files))))
320 ;; fix-me: ask for site
321 ;;(when (called-interactively-p) )
322 (rgrep regexp files (html-site-current-site-dir)))
325 (defun html-site-query-replace (from to file-regexp delimited)
326 "Query replace in current site's files."
328 (let ((parameters (dir-replace-read-parameters t t)))
330 ;;(length parameters)
331 (setcdr (nthcdr 2 parameters) (nthcdr 4 parameters))
332 ;;(length parameters)
334 ;; fix-me: ask for site
335 ;;(when (called-interactively-p) )
336 (rdir-query-replace from to file-regexp
338 (html-site-current-site-dir)
342 (defun html-site-ensure-site-defined (site-name)
343 (unless html-site-list
344 (error "No sites defined. Please customize `html-site-list'."))
345 (unless (file-directory-p (html-site-site-dir site-name))
346 (error "Local file web site directory does not exists: %s"
347 (html-site-site-dir site-name))))
348 (defun html-site-current-ensure-site-defined ()
349 (unless (and (< 0 (length html-site-current))
350 (assoc html-site-current html-site-list))
351 (error "No current site set"))
352 (html-site-ensure-site-defined html-site-current))
354 (defun html-site-remote-contains (site-name url with-toc)
355 (html-site-dir-contains (html-site-remote-root site-name with-toc) url))
356 (defun html-site-current-remote-contains (url with-toc)
357 (html-site-remote-contains html-site-current url with-toc))
359 (defun html-site-ensure-file-in-site (site-name file-name &optional no-error)
360 (html-site-ensure-site-defined site-name)
361 (if (html-site-contains site-name file-name)
365 (error "This file is not in site %s" site-name))))
366 (defun html-site-current-ensure-file-in-site (file-name)
367 ;;(html-site-ensure-file-in-site html-site-current file-name))
368 (let ((in-site (html-site-ensure-file-in-site html-site-current
372 (format "This file is not in site %s, change site? "
374 (error "This file is not in site %s" html-site-current)
375 (let ((must-contain t))
376 (call-interactively 'html-site-set-site))
377 (setq in-site (html-site-ensure-file-in-site html-site-current
380 (defun html-site-ensure-buffer-in-site (site-name)
381 (unless buffer-file-name
382 (error "This buffer is not visiting a file"))
383 (html-site-ensure-file-in-site site-name buffer-file-name))
384 (defun html-site-current-ensure-buffer-in-site ()
385 (html-site-ensure-buffer-in-site html-site-current))
388 (defun html-site-site-dir (site-name)
389 (file-name-as-directory
390 (nth 1 (assoc site-name html-site-list))))
391 (defun html-site-current-site-dir () (html-site-site-dir html-site-current))
393 (defun html-site-contains (site-name file)
394 (html-site-dir-contains (html-site-site-dir site-name) file))
395 (defun html-site-current-contains (file)
396 (html-site-contains html-site-current file))
398 (defun html-site-page-list (site-name)
399 (let ((page-list (nth 2 (assoc site-name html-site-list))))
400 (when (< 0 (length page-list))
403 (defun html-site-current-page-list () (html-site-page-list html-site-current))
405 (defun html-site-frames-file (site-name)
406 (nth 3 (assoc site-name html-site-list)))
407 (defun html-site-current-frames-file () (html-site-frames-file html-site-current))
409 (defun html-site-toc-file (site-name)
410 (nth 4 (assoc site-name html-site-list)))
411 (defun html-site-current-toc-file () (html-site-toc-file html-site-current))
413 (defun html-site-merge-dir (site-name)
414 (let ((dir (nth 5 (assoc site-name html-site-list))))
415 (when (< 0 (length dir))
417 (defun html-site-current-merge-dir () (html-site-merge-dir html-site-current))
419 (defun html-site-merge-template (site-name)
420 (nth 6 (assoc site-name html-site-list)))
421 (defun html-site-current-merge-template () (html-site-merge-template html-site-current))
423 (defun html-site-extra-fun (site-name)
424 (nth 7 (assoc site-name html-site-list)))
425 (defun html-site-current-extra-fun () (html-site-extra-fun html-site-current))
427 (defun html-site-ftp-host (site-name)
428 (nth 8 (assoc site-name html-site-list)))
429 (defun html-site-current-ftp-host () (html-site-ftp-host html-site-current))
431 (defun html-site-ftp-user (site-name)
432 (nth 9 (assoc site-name html-site-list)))
433 (defun html-site-current-ftp-user () (html-site-ftp-user html-site-current))
435 (defun html-site-ftp-password (site-name)
436 (nth 10 (assoc site-name html-site-list)))
437 (defun html-site-current-ftp-password () (html-site-ftp-password html-site-current))
439 (defun html-site-ftp-dir (site-name)
440 (nth 11 (assoc site-name html-site-list)))
441 (defun html-site-current-ftp-dir () (html-site-ftp-dir html-site-current))
443 (defun html-site-ftp-wtoc-dir (site-name)
444 (nth 12 (assoc site-name html-site-list)))
445 (defun html-site-current-ftp-wtoc-dir () (html-site-ftp-wtoc-dir html-site-current))
447 (defun html-site-web-host (site-name)
448 (nth 13 (assoc site-name html-site-list)))
449 (defun html-site-current-web-host () (html-site-web-host html-site-current))
451 (defun html-site-web-dir (site-name)
452 (nth 14 (assoc site-name html-site-list)))
453 (defun html-site-current-web-dir () (html-site-web-dir html-site-current))
455 (defun html-site-web-wtoc-dir (site-name)
456 (nth 15 (assoc site-name html-site-list)))
457 (defun html-site-current-web-wtoc-dir () (html-site-web-wtoc-dir html-site-current))
459 (defun html-site-web-full (site-name with-toc)
460 (let ((host (html-site-web-host site-name)))
463 (error "Web site host not known for %s" site-name))
465 (unless (string-match "^https?://" host)
466 (setq host (concat "http://" host))))
469 (html-site-web-wtoc-dir site-name)
470 (html-site-web-dir site-name)))))
471 (defun html-site-current-web-full (with-toc)
472 (html-site-web-full html-site-current with-toc))
474 (defvar html-site-ftp-temporary-passwords nil)
475 (defun html-site-get-ftp-pw ()
476 (let ((pw (html-site-current-ftp-password)))
477 (unless (< 0 (length pw))
478 (let* ((user-site (concat (html-site-current-ftp-user)
480 (html-site-current-ftp-host)))
481 (site-pw (assoc user-site html-site-ftp-temporary-passwords)))
483 (setq pw (cdr site-pw))
484 (setq pw (read-string
485 (concat "Ftp password for "
486 (html-site-current-ftp-user)
488 (html-site-current-ftp-host)
490 (setq html-site-ftp-temporary-passwords
493 html-site-ftp-temporary-passwords)))))
500 (defun html-site-path-in-mirror (site-root path-in-site mirror-root)
501 (assert (html-site-dir-contains site-root path-in-site) t)
502 (let ((rel-path (file-relative-name path-in-site site-root)))
503 (if (string= rel-path ".")
504 (directory-file-name mirror-root)
505 (concat (file-name-as-directory mirror-root) rel-path))))
507 ;; Some checks to see if html-site-path-in-mirror works:
510 ;; Try to make a non-existent directory name to work around Emacs
511 ;; bug (which was fixed today in CVS):
512 (let ((local-file "/temp814354/in/hej.html")
513 (local-dir "/temp814354"))
514 (when (memq system-type '(ms-dos windows-nt))
515 (setq local-file (concat "c:" local-file))
516 (setq local-dir (concat "c:" local-dir )))
518 "http://some.site/tempmirror/in/hej.html"
519 (html-site-path-in-mirror local-dir
521 "http://some.site/tempmirror"))
525 (html-site-path-in-mirror "http://some.site/tempmirror"
526 "http://some.site/tempmirror/in/hej.html"
531 (file-relative-name "http:/temp/in/hej.html" "http:/temp"))
536 (defun html-site-local-to-web (site-name local-file with-toc)
537 (html-site-ensure-file-in-site site-name local-file)
538 (html-site-path-in-mirror (html-site-site-dir site-name)
540 (html-site-web-full site-name with-toc)))
541 (defun html-site-current-local-to-web (local-file with-toc)
542 (html-site-local-to-web html-site-current local-file with-toc))
544 (defun html-site-remote-root (site-name with-toc)
546 (html-site-ftp-user site-name)
547 "@" (html-site-ftp-host site-name)
550 (html-site-ftp-wtoc-dir site-name)
551 (html-site-ftp-dir site-name))))
552 (defun html-site-current-remote-root (with-toc)
553 (html-site-remote-root html-site-current with-toc))
555 (defun html-site-local-to-remote (site-name local-file with-toc)
556 (html-site-ensure-file-in-site site-name local-file)
557 (html-site-path-in-mirror (html-site-site-dir site-name)
559 (html-site-remote-root site-name with-toc)))
560 (defun html-site-current-local-to-remote (local-file with-toc)
561 (html-site-local-to-remote html-site-current local-file with-toc))
563 (defun html-site-remote-to-local (site-name remote-file with-toc)
564 ;;(html-site-ensure-file-in-site remote-file)
566 (html-site-path-in-mirror (html-site-remote-root site-name with-toc)
568 (html-site-site-dir site-name)))
569 (defun html-site-current-remote-to-local (remote-file with-toc)
570 (html-site-remote-to-local html-site-current remote-file with-toc))
573 (defvar html-site-files-re "\.x?html?$")
575 (defun html-site-edit-pages-file ()
576 "Edit the list of pages to be used for table of contents."
578 (html-site-current-ensure-site-defined)
579 (find-file (html-site-current-page-list))
582 (defun html-site-get-sub-files (dir file-patt)
585 (dir-files (directory-files dir t "^[^.]")))
586 (dolist (f dir-files)
587 (if (file-directory-p f)
588 (add-to-list 'sub-dirs f)
589 (when (string-match file-patt f)
590 (add-to-list 'sub-files f))))
591 (dolist (sub-dir sub-dirs)
592 (setq sub-files (append sub-files (html-site-get-sub-files sub-dir file-patt)))
596 (defun html-site-file-is-local (filename)
597 "Return t if FILENAME is a local file name.
598 No check is done that the file exists."
599 ;;(find-file-name-handler "/ftp:c:/eclean/" 'file-exists-p)
600 (null (find-file-name-handler filename 'file-exists-p)))
602 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
603 ;;; Put subprocess here at the moment ...
605 (defconst noshell-procbuf-name "*Noshell process buffer*")
607 (defvar noshell-proc-name nil)
608 (defun noshell-procbuf-setup (procbuf-name)
610 (setq procbuf-name noshell-procbuf-name))
611 (with-current-buffer (get-buffer-create procbuf-name)
612 (unless (get-buffer-window (current-buffer))
613 (when (one-window-p) (split-window))
614 (let ((cb (current-buffer)))
615 (set-window-buffer (other-window 1) cb)))
616 ;;(setq buffer-read-only t)
617 (noshell-process-mode)
618 (compilation-minor-mode 1)
619 ;; (let ((inhibit-read-only t)
620 ;; (output-buffer (current-buffer)))
621 ;; (goto-char (point-max))
622 ;; (setq noshell-proc-name name)
624 ;; "\n\n\n>>>>>>>>>>>>>>>>>> Starting "
625 ;; noshell-proc-name "\n")))
626 ;; (put-text-property 0 (length s)
627 ;; 'face (list 'bold '(:foreground "green"))
630 (sit-for 0.01) ;; Display update
633 (defun noshell-procbuf-teardown (proc)
634 (with-current-buffer (process-buffer proc)
635 (goto-char (point-max))
636 (let ((inhibit-read-only t)
638 "<<<<<<<<<<<<<<<<<<< Finished OK: "
639 noshell-proc-name "\n")))
640 (put-text-property 0 (length s)
641 'face (list 'bold '(:foreground "green"))
645 (defun noshell-procbuf-run (buffer prog &rest args)
646 (with-current-buffer buffer
647 (let ((inhibit-read-only t)
652 (setq proc (apply 'start-process "myproc" (current-buffer) prog args))
657 (let ((s "\n\n<<<<<<<<<<<<< There was a process starting error!"))
658 (put-text-property 0 (length s)
659 'face (list 'bold '(:foreground "red"))
662 (error "Subprocess terminated with error status")))
663 (set-process-sentinel proc 'noshell-sentinel)
667 (defun noshell-sentinel (process event)
668 (with-current-buffer (process-buffer process)
669 (let ((inhibit-read-only t))
670 ;;(insert (format "Process: %s recieved %s\n" process event))
671 (cond ((string-match "abnormally" event)
672 (let ((s (concat "\n<<<<<< Error: "
673 (substring event 0 -1)
675 (put-text-property 0 (length s)
676 'face (list 'bold '(:foreground "red"))
679 ((string-match "finished" event)
680 (noshell-procbuf-teardown process))
684 (defun noshell-procbuf-syncrun (prog &rest args)
685 (with-current-buffer (get-buffer noshell-procbuf-name)
686 (let ((inhibit-read-only t)
690 ;;(setq sts (apply 'call-process prog nil (current-buffer) t args))
691 (setq sts (apply 'call-process prog nil (list (current-buffer) t) t args))
696 (let ((s (format "\n\n<<<<<<<<<<<<< There was a process error: %s" sts)))
697 (put-text-property 0 (length s)
698 'face (list 'bold '(:foreground "red"))
701 (error "Subprocess terminated with error status")))
706 (defvar noshell-process-mode-map
707 (let ((map (make-sparse-keymap)))
708 (define-key map [(control ?c)(control ?k)] 'noshell-kill-subprocess)
709 (define-key map [(control ?g)] 'noshell-quit)
712 (define-derived-mode noshell-process-mode fundamental-mode "Subprocess"
714 (setq buffer-read-only t)
715 (buffer-disable-undo (current-buffer)))
717 (defun noshell-quit ()
719 (noshell-kill-subprocess)
722 (defun noshell-kill-subprocess ()
724 (when (eq major-mode 'noshell-process-mode)
725 (if (get-buffer-process (current-buffer))
726 (interrupt-process (get-buffer-process (current-buffer)))
727 (error "The subprocess is not running"))))
731 ;; Provide here to be able to load the files in any order
734 (eval-when-compile (require 'html-upl nil t))
736 (defvar html-site-mode-menu-map
737 (let ((map (make-sparse-keymap "html-site-mode-menu-map")))
739 (when (featurep 'html-upl)
740 (let ((upl-map (make-sparse-keymap)))
741 (define-key map [html-site-upl-map]
742 (list 'menu-item "File Transfer" upl-map))
743 ;;(define-key upl-map [html-site-upl-edit-remote-wtoc]
744 ;; (list 'menu-item "Edit Remote File With TOC" 'html-upl-edit-remote-file-with-toc))
745 (define-key upl-map [html-site-upl-edit-remote]
746 (list 'menu-item "Edit Remote File" 'html-upl-edit-remote-file))
747 (define-key upl-map [html-site-upl-ediff-buffer]
748 (list 'menu-item "Ediff Remote/Local Files" 'html-upl-ediff-file))
749 (define-key upl-map [html-site-upl-sep] (list 'menu-item "--"))
750 (define-key upl-map [html-site-upl-upload-site-with-toc]
751 (list 'menu-item "Upload Site with TOC" 'html-upl-upload-site-with-toc))
752 (define-key upl-map [html-site-upl-upload-site]
753 (list 'menu-item "Upload Site" 'html-upl-upload-site))
754 (define-key upl-map [html-site-upl-upload-file]
755 (list 'menu-item "Upload Single File" 'html-upl-upload-file))
758 (let ((site-map (make-sparse-keymap)))
759 (define-key map [html-site-site-map]
760 (list 'menu-item "Site" site-map))
761 (define-key site-map [html-site-customize-site-list]
762 (list 'menu-item "Edit Sites" (lambda () (interactive)
763 (customize-option 'html-site-list))))
764 (define-key site-map [html-site-set-site]
765 (list 'menu-item "Set Current Site" 'html-site-set-site))
771 (defvar html-site-mode-map
772 (let ((map (make-sparse-keymap )))
773 (define-key map [menu-bar html-site-mode]
774 (list 'menu-item "Web Site" html-site-mode-menu-map))
777 (define-minor-mode html-site-mode
778 "Adds a menu for easy access of setting site, uploading etc."
781 :keymap html-site-mode-map
784 (defvar html-site-mode-off-list
787 (define-global-minor-mode html-site-global-mode html-site-mode
790 (when t ;buffer-file-name
791 (unless (memq major-mode html-site-mode-off-list)
792 (html-site-mode 1))))
794 ;; The problem with global minor modes:
795 (when (and html-site-global-mode
796 (not (boundp 'define-global-minor-mode-bug)))
797 (html-site-global-mode 1))
800 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
801 ;;; html-site.el ends here