;;; nxhtml-mode.el --- Edit XHTML files
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Parts are from Peter Heslin (see below)
;; Created: 2005-08-05
;;Version:
;; Last-Updated: 2008-12-28 Sun
;; Keywords: languages
;;
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; The purpose of nxhtml.el is to add some features that are useful
;; when editing XHTML files to nxml-mode. For more information see
;; `nxhtml-mode'.
;;
;;
;; Usage:
;;
;; See the file readme.txt in the directory above this file. Or, if
;; you do not have that follow the instructions below.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; History:
;;
;; 2006-04-25: Added completion for href, src etc. Removed xhtmlin.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This file is not part of Emacs
;;
;; 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 (require 'cl))
(eval-when-compile (require 'hideshow))
(eval-when-compile (require 'appmenu-fold nil t))
(eval-when-compile (require 'fold-dwim nil t))
(eval-when-compile (require 'foldit nil t))
(eval-when-compile (require 'html-pagetoc nil t))
(eval-when-compile (require 'html-toc nil t))
(eval-when-compile (require 'mumamo nil t))
(eval-when-compile (require 'mlinks nil t))
(eval-when-compile (require 'nxhtml-base))
;;(eval-when-compile (require 'nxhtml-menu)) ;; recursive load
(eval-when-compile (require 'ourcomments-util nil t))
(eval-and-compile (require 'typesetter nil t))
(eval-when-compile (require 'xhtml-help nil t))
(eval-when-compile (require 'popcmp nil t))
;; (eval-when-compile
;; (unless (or (< emacs-major-version 23)
;; (boundp 'nxhtml-menu:version)
;; (featurep 'nxhtml-autostart))
;; (let ((efn (expand-file-name
;; "../autostart.el"
;; (file-name-directory
;; (or load-file-name
;; (when (boundp 'bytecomp-filename) bytecomp-filename)
;; buffer-file-name)))))
;; (message "efn=%s" efn)
;; (load efn))
;; (require 'rng-valid)
;; (require 'rng-nxml)))
(require 'button)
(require 'loadhist)
(require 'nxml-mode nil t)
(require 'rng-nxml nil t)
(require 'rng-valid nil t)
;; Require nxml things conditionally to silence byte compiler under
;; Emacs 22.
(eval-and-compile (require 'rngalt nil t))
(require 'url-parse)
(require 'url-expand)
(require 'popcmp nil t)
(eval-when-compile (require 'html-imenu nil t))
(eval-when-compile (require 'tidy-xhtml nil t))
(eval-when-compile (require 'html-quote nil t))
(defun nxhtml-version ()
"Show nxthml version."
(interactive)
(message "nXhtml mode version %s" nxhtml-menu:version))
;;(defun nxhtml-nxml-fontify-attribute (att &optional namespace-declaration)
;;"Holds the original `nxml-fontify-attribute' function.")
;;(fset 'nxhtml-nxml-fontify-attribute (symbol-function 'nxml-fontify-attribute))
(defun nxhtml-turn-onoff-tag-do-also (on)
(add-hook 'nxhtml-mode-hook 'nxhtml-check-tag-do-also)
(dolist (b (buffer-list))
(when (with-current-buffer b
(eq major-mode 'nxhtml-mode))
(if on
(progn
(add-hook 'rngalt-complete-tag-hooks 'nxhtml-complete-tag-do-also t t)
)
(remove-hook 'rngalt-complete-tag-hooks 'nxhtml-complete-tag-do-also t)
))))
;;(define-toggle nxhtml-tag-do-also t
(define-minor-mode nxhtml-tag-do-also
"When completing tag names do some more if non-nil.
For some tag names additional things can be done at completion to
speed writing up. For example for an tag `nxhtml-mode'
can prompt for src attribute and add width and height attributes
if this attribute points to a local file.
You can add additional elisp code for completing to
`nxhtml-complete-tag-do-also'."
:global t
:init-value t
:group 'nxhtml
(nxhtml-turn-onoff-tag-do-also nxhtml-tag-do-also))
(when nxhtml-tag-do-also (nxhtml-tag-do-also 1))
(defun nxhtml-tag-do-also-toggle ()
"Toggle `nxhtml-tag-do-also'."
(interactive)
(nxhtml-tag-do-also (if nxhtml-tag-do-also -1 1)))
(defun nxhtml-check-tag-do-also ()
(when nxhtml-tag-do-also
(nxhtml-turn-onoff-tag-do-also t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Folding etc.
;; This part is origially taken from
;; http://www.emacswiki.org/cgi-bin/wiki/NxmlModeForXHTML and was
;; originally written by Peter Heslin, but has been changed rather
;; much.
;; (defun nxhtml-hs-adjust-beg-func (pos)
;; (save-excursion
;; (save-match-data
;; ;; (search-backward "<" nil t)
;; ;; (forward-char)
;; ;; (search-forward ">" nil t)
;; )
;; (point)))
(defun nxhtml-hs-forward-sexp-func (pos)
(nxhtml-hs-forward-element))
(defun nxhtml-hs-forward-element ()
(let ((nxml-sexp-element-flag))
(setq nxml-sexp-element-flag (not (looking-at ""
"")
t))
((eq where 'in-xml-attr-val)
(let (attr
delimiter
val)
(save-excursion
(save-match-data
(re-search-forward "\\=[^<> \t\r\n\"]*" nil t)))
(let* ((name-start (match-beginning 1))
(name-end (match-end 1))
(colon (match-beginning 2))
(attr (buffer-substring-no-properties name-start
(or colon name-end)))
(value-start (1+ (match-beginning 3)))
(tag (save-excursion
(when (search-backward-regexp "<[[:alpha:]]+" nil t)
(match-string 0))))
(init (buffer-substring-no-properties value-start (point))))
(setq delimiter (char-before value-start))
(cond ((string= "encoding" attr)
;; Give a default that works in browsers today
(setq val (nxhtml-coding-systems-complete
init
(symbol-name nxhtml-default-encoding))))
((string= "version" attr)
(setq val "1.0")))
(when val
(insert val)
t)
)))
((or (memq where '(in-text
after-validation-header
in-empty-page)))
(rngalt-complete-tag-region-prepare)
(insert "<")
(condition-case err
(nxhtml-redisplay-complete)
(quit
(message "%s" (error-message-string err))
(undo-start)
(undo-more 1)
(rngalt-complete-tag-region-cleanup)))
t)
(t
;;(message "LAST TRY where=%s" (nxhtml-check-where))(sit-for 1)
nil)
))))
(defun nxhtml-img-tag-do-also ()
(insert "alt=\"")
(rngalt-validate)
(insert (read-string "Alt attribute: ")
"\" ")
(insert "src=\"")
(rngalt-validate)
(let ((src (nxhtml-read-url nil nil 'nxhtml-image-url-predicate "Image")))
(insert src)
(insert "\"")
(when (file-exists-p src)
(let ((sizes (image-size (create-image (expand-file-name src)) t)))
(insert
" width=\"" (format "%d" (car sizes)) "\""
" height=\"" (format "%d" (cdr sizes)) "\"")
)))
(unless (save-match-data (looking-at "[^<]\\{,200\\}>"))
(insert " />")))
(defun nxhtml-redisplay-complete ()
(rngalt-validate)
(rng-cancel-timers)
(message "")
(redisplay t)
(nxml-complete)
(rng-activate-timers))
(defun nxhtml-read-from-minibuffer (prompt &optional
initial-contents keymap
read hist default-value
inherit-input-method)
(rng-cancel-timers)
(message "")
(let ((res (read-from-minibuffer prompt initial-contents keymap
read hist default-value inherit-input-method)))
(rng-activate-timers)
res))
(defun nxhtml-meta-tag-do-also ()
(let ((type (popcmp-completing-read
"Type: "
'(
;;"Refresh/Redirect"
"HTTP Message Headers"
"Robot Rules"
"Description for Search Engines"
))))
(cond
((string= type "Description for Search Engines")
(insert " name=\"Description\"")
(insert " content=\"")
(insert (nxhtml-read-from-minibuffer "Description: "))
(insert "\" />"))
((string= type "Robot Rules")
(insert " name=\"Robots\"")
(insert " content=\"")
(nxhtml-redisplay-complete)
(insert " />"))
((string= type "HTTP Message Headers")
(insert " http-equiv=\"")
(nxhtml-redisplay-complete)
(insert " content=\"")
(insert (nxhtml-read-from-minibuffer "Content: "))
(insert "\" />")))))
(defun nxhtml-style-tag-do-also ()
(insert "type=\"text/css\"")
(insert " media=\"")
(nxhtml-redisplay-complete)
(insert ">")
(indent-according-to-mode)
(insert "\n/* */")
(indent-according-to-mode)
(insert "\n")
(indent-according-to-mode)
(insert "\n")
(end-of-line -2))
(defun nxhtml-script-tag-do-also ()
(let ((type (popcmp-completing-read
"Type: "
'("Inlined"
"Linked"))))
(cond
((string= type "Inlined")
(insert "type=\"text/javascript\">")
(indent-according-to-mode)
(insert "\n// ")
(indent-according-to-mode)
(insert "\n")
(indent-according-to-mode)
(end-of-line -1))
((string= type "Linked")
(insert "type=\"text/javascript\"")
(insert " src=\"")
(nxhtml-redisplay-complete)
(insert ">")))))
(defun nxhtml-link-tag-do-also ()
(let ((type (popcmp-completing-read "Type: "
'(
"Other"
"Shortcut icon"
"Style sheet"
))))
(cond
((string= type "Style sheet")
(insert " rel=\"Stylesheet\" ")
(insert "type=\"text/css\" ")
(insert "href=\"")
(nxhtml-redisplay-complete)
(insert " media=\"")
(nxhtml-redisplay-complete)
(insert " />"))
((string= type "Shortcut icon")
(insert " rel=\"Shortcut Icon\" ")
(insert "href=\"")
(nxhtml-redisplay-complete)
(insert " />"))
(t
(insert " ")
(nxhtml-redisplay-complete)
))))
(defun nxhtml-input-tag-do-also ()
(insert " ")
(rngalt-validate)
;; type=
(insert "type=\"")
(nxhtml-redisplay-complete)
(insert " ")
(let* ((choice (save-match-data
(when (looking-back "type=\"\\(.*\\)\" ")
(match-string 1)))))
;;(insert "type=\"" choice "\" ")
(rngalt-validate)
;;(message "choice=%s" choice)(sit-for 2)
;; name=
(when (member choice '("button" "checkbox" "file" "hidden" "image"
"password" "radio" "text"))
(insert "name=\""
(read-string "Name (name): ")
"\" ")
(rngalt-validate))
;; checked=
(when (member choice '("checkbox" "radio"))
(when (y-or-n-p "Checked? (checked): ")
(insert "checked=\"checked\" ")
(rngalt-validate)))
;; disabled=
(unless (string= choice "hidden")
(unless (y-or-n-p "Enabled? : ")
(insert "disabled=\"disabled\" ")
(rngalt-validate)))
;; readonly=
(when (string= choice "text")
(when (y-or-n-p "Readonly? (readonly): ")
(insert "readonly=\"readonly\" "))
(rngalt-validate))
(when (string= choice "file")
;; accept=
(require 'mailcap)
(condition-case err
(let ((prompt (concat
"Accept mime type, RET to stop ("
"C-g to skip"
"): "))
(mime " ")
mimes
(types (when (boundp 'mailcap-mime-extensions)
(mapcar (lambda (elt)
(cdr elt))
mailcap-mime-extensions))))
(while (< 0 (length mime))
(setq mime
(if types
(completing-read prompt types)
(read-string prompt)))
(when (< 0 (length mime))
(if mimes
(setq mimes (concat mimes "," mime))
(setq mimes mime))))
(when (and mimes
(< 0 (length mimes)))
(insert "accept=\"" mimes "\" ")))
(quit (message "Skipped accept attribute")))
(rngalt-validate))
(when (string= choice "image")
;; alt=
(insert "alt=\"")
(rngalt-validate)
(insert (read-string "Alt attribute: ")
"\" ")
(rngalt-validate)
;; src=
(insert "src=\"")
(rngalt-validate)
(let ((src (nxhtml-read-url nil nil 'nxhtml-image-url-predicate "Image")))
(insert src)
(insert "\" "))
(rngalt-validate))
;; value=
(cond
((member choice '("button" "reset" "submit"))
(nxhtml-do-also-value "Label"))
((member choice '("checkbox" "radio"))
(nxhtml-do-also-value "Result"))
((member choice '("hidden" "password" "text"))
(nxhtml-do-also-value "Value"))
)
(insert "/>")
;;(message "type=%s" choice)(sit-for 2)
))
(defun nxhtml-do-also-value (label)
(let ((v (read-string (concat label " (value): "))))
(when (and v
(< 0 (length v)))
(insert " value=\"" v "\" "))))
(defun nxhtml-form-tag-do-also ()
(insert "action=\"")
(rngalt-validate)
(let ((src (nxhtml-read-url nil nil nil "Action")))
(insert src "\" "))
)
(defun nxhtml-a-tag-do-also ()
(insert " href=\"")
(rngalt-validate)
(insert (nxhtml-read-url t))
(insert "\"")
(let* ((pre-choices '("_blank" "_parent" "_self" "_top"))
(all-choices (reverse (cons "None" (cons "Frame name" pre-choices))))
choice
(prompt "Target: "))
(setq choice (popcmp-completing-read prompt all-choices nil t
"" nil nil t))
(unless (string= choice "None")
(insert " target=\"")
(cond ((member choice pre-choices)
(insert choice "\""))
((string= choice "Frame name")
(rngalt-validate)
(insert (read-string "Frame name: ") "\""))
(t (error "Uh?")))))
(insert ">")
(rngalt-validate)
(insert (read-string "Link title: ")
""))
(defconst nxhtml-complete-tag-do-also
'(("a" nxhtml-a-tag-do-also)
;; (lambda ()
;; (insert " href=\"")
;; (rngalt-validate)
;; (insert (nxhtml-read-url t))
;; (insert "\"")))
("form" nxhtml-form-tag-do-also)
("img" nxhtml-img-tag-do-also)
("input" nxhtml-input-tag-do-also)
("link" nxhtml-link-tag-do-also)
("script" nxhtml-script-tag-do-also)
("style" nxhtml-style-tag-do-also)
("meta" nxhtml-meta-tag-do-also)
)
"List of functions to call at tag completion.
Each element of the list have the form
\(TAG-NAME TAG-FUN)
If `nxhtml-tag-do-also' is non-nil then TAG-FUN is called after
by `nxml-complete' (with the special setup of this function for
`nxhtml-mode') when completing a tag with the name TAG-NAME.
The list is handled as an association list, ie only the first
occurence of a tag name is used.")
(defun nxhtml-complete-tag-do-also-for-state-completion (dummy-completed)
"Add this to state completion functions completed hook."
(when (and nxhtml-tag-do-also
(derived-mode-p 'nxhtml-mode))
;; Find out tag
(let ((tag nil))
(save-match-data
;;(when (looking-back "<\\([a-z]+\\)[[:blank:]]+")
(when (looking-back "<\\([a-z]+\\)")
(setq tag (match-string 1))))
(when tag
(insert " ")
(nxhtml-complete-tag-do-also tag)))))
(defun nxhtml-complete-tag-do-also (tag)
;; First required attributes:
(let ((tagrec (assoc tag nxhtml-complete-tag-do-also)))
(when tagrec
(funcall (cadr tagrec))))
)
;;;###autoload
(define-minor-mode nxhtml-validation-header-mode
"If on use a Fictive XHTML Validation Header for the buffer.
See `nxhtml-set-validation-header' for information about Fictive XHTML Validation Headers.
This mode may be turned on automatically in two ways:
- If you try to do completion of a XHTML tag or attribute then
`nxthml-mode' may ask you if you want to turn this mode on if
needed.
- You can also choose to have it turned on automatically whenever
a mumamo multi major mode is used, see
`nxhtml-validation-header-if-mumamo' for further information."
:global nil
:lighter " VH"
:group 'nxhtml
(if nxhtml-validation-header-mode
(progn
(unless nxhtml-current-validation-header
(setq nxhtml-current-validation-header
(nxhtml-get-default-validation-header)))
;;(message "nxhtml-current-validation-header=%s" nxhtml-current-validation-header)
(if nxhtml-current-validation-header
(progn
(nxhtml-apply-validation-header)
(add-hook 'change-major-mode-hook 'nxhtml-vhm-change-major nil t)
(when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
(add-hook 'mumamo-change-major-mode-hook 'nxhtml-vhm-mumamo-change-major nil t)
(add-hook 'mumamo-after-change-major-mode-hook 'nxhtml-vhm-mumamo-after-change-major nil t)))
(run-with-idle-timer 0 nil 'nxhtml-validation-header-empty (current-buffer))))
(rngalt-set-validation-header nil)
(setq nxhtml-current-validation-header nil)
(remove-hook 'after-change-major-mode-hook 'nxhtml-vhm-after-change-major t)
(when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
(remove-hook 'mumamo-change-major-mode-hook 'nxhtml-vhm-mumamo-change-major t)
(remove-hook 'mumamo-after-change-major-mode-hook 'nxhtml-vhm-mumamo-after-change-major t))))
(defun nxhtml-can-insert-page-here ()
(and (not nxhtml-validation-header-mode)
(= 1 (point))
(or (= 0 (buffer-size))
(save-restriction
(widen)
(save-match-data
(looking-at (rx buffer-start
(0+ space)
buffer-end)))))))
(defun nxhtml-complete-first-try ()
(when (nxhtml-can-insert-page-here)
(nxhtml-empty-page-completion)))
(defun nxhtml-completing-read-tag (prompt
table
&optional predicate require-match
initial-input hist def inherit-input-method)
(let ((popcmp-in-buffer-allowed t))
(popcmp-completing-read prompt
table
predicate require-match
initial-input hist def inherit-input-method
nxhtml-help-tag
nxhtml-tag-sets)))
(defun nxhtml-add-required-to-attr-set (tag)
(let ((missing (when tag
(rngalt-get-missing-required-attr
(nxthml-is-single-tag tag)))))
(if (not missing)
nxhtml-attr-sets
(cons (cons "Required" missing)
nxhtml-attr-sets))))
(defun nxhtml-get-tag-specific-attr-help (tag)
(append (cdr (assoc tag nxhtml-help-attribute-name-tag)) nxhtml-help-attribute-name)
)
(defconst nxhtml-in-start-tag-regex
;;(defconst rng-in-start-tag-name-regex
(replace-regexp-in-string
"w"
xmltok-ncname-regexp
;; Not entirely correct since < could be part of attribute value:
"<\\(w\\(?::w?\\)?\\)+ [^<]*"
t
t))
(defun nxhtml-completing-read-attribute-name (prompt
table
&optional predicate require-match
initial-input hist def inherit-input-method)
(let* ((tag (save-match-data
;;(when (looking-back "<\\([a-z1-6]+\\) [^<]*")
(when (looking-back nxhtml-in-start-tag-regex)
(match-string 1))))
(attr-sets (nxhtml-add-required-to-attr-set tag))
(help-attr (nxhtml-get-tag-specific-attr-help tag))
(popcmp-in-buffer-allowed t)
)
(popcmp-completing-read prompt
table
predicate require-match
initial-input hist def inherit-input-method
help-attr
attr-sets)))
(defun nxhtml-completing-read-attribute-value (prompt
table
&optional predicate require-match
initial-input hist def inherit-input-method)
(let (val)
(if table
(let ((popcmp-in-buffer-allowed t))
(setq val (popcmp-completing-read prompt table
predicate require-match
initial-input hist def inherit-input-method)))
(let* (init
delimiter
(lt-pos (save-excursion (search-backward "<" nil t)))
(in-attr-val
(save-excursion
(re-search-backward rng-in-attribute-value-regex lt-pos t)))
(in-xml-attr-val
(unless in-attr-val
(save-excursion
(re-search-backward nxhtml-in-xml-attribute-value-regex lt-pos t))))
)
(when (or in-attr-val in-xml-attr-val)
;;(save-match-data (save-excursion (re-search-forward "\\=[^<> \t\r\n\"]*" nil t)))
(let* ((name-start (match-beginning 1))
(name-end (match-end 1))
(colon (match-beginning 2))
(attr (buffer-substring-no-properties name-start
(or colon name-end)))
(value-start (1+ (match-beginning 3)))
tag-start-end
(tag (save-excursion
(when (search-backward-regexp "<[[:alpha:]]+" nil t)
(setq tag-start-end (match-end 0))
(match-string-no-properties 0)))))
(setq init (buffer-substring-no-properties value-start (point)))
(setq delimiter (char-before value-start))
(if in-xml-attr-val
(error "in-xml-attr-val should not be true here!")
;; (cond ((string= "encoding" attr)
;; ;; Give a default that works in browsers today
;; (setq val (nxhtml-coding-systems-complete
;; init
;; (symbol-name nxhtml-default-encoding))))
;; ((string= "version" attr)
;; (setq val "1.0")))
(cond ((string= "rel" attr)
(cond ((string= "