;;; 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= "