summaryrefslogtreecommitdiff
path: root/lisp/textmodes/sgml-mode.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/textmodes/sgml-mode.el')
-rw-r--r--lisp/textmodes/sgml-mode.el52
1 files changed, 42 insertions, 10 deletions
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index efebee0521b..b49541f47d4 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -75,7 +75,8 @@ a DOCTYPE or an XML declaration."
:type 'boolean
:version "22.1")
-(defvaralias 'sgml-transformation 'sgml-transformation-function)
+(define-obsolete-variable-alias 'sgml-transformation
+ 'sgml-transformation-function "29.1")
(defcustom sgml-transformation-function 'identity
"Default value for `skeleton-transformation-function' in SGML mode."
@@ -418,11 +419,11 @@ These have to be run via `sgml-syntax-propertize'"))
(defun sgml-syntax-propertize (start end &optional rules-function)
"Syntactic keywords for `sgml-mode'."
(setq sgml--syntax-propertize-ppss (cons start (syntax-ppss start)))
- (cl-assert (>= (cadr sgml--syntax-propertize-ppss) 0))
- (sgml-syntax-propertize-inside end)
- (funcall (or rules-function sgml--syntax-propertize) (point) end)
- ;; Catch any '>' after the last quote.
- (sgml--syntax-propertize-ppss end))
+ (when (>= (cadr sgml--syntax-propertize-ppss) 0)
+ (sgml-syntax-propertize-inside end)
+ (funcall (or rules-function sgml--syntax-propertize) (point) end)
+ ;; Catch any '>' after the last quote.
+ (sgml--syntax-propertize-ppss end)))
(defun sgml-syntax-propertize-inside (end)
(let ((ppss (syntax-ppss)))
@@ -440,7 +441,8 @@ These have to be run via `sgml-syntax-propertize'"))
;; internal
(defvar sgml-face-tag-alist ()
- "Alist of face and tag name for facemenu.")
+ "Alist of face and tag name for facemenu.
+The tag name can be a string or a list of strings.")
(defvar sgml-tag-face-alist ()
"Tag names and face or list of faces to fontify with when invisible.
@@ -528,11 +530,13 @@ an optional alist of possible values."
(comment-indent-new-line soft)))
(defun sgml-mode-facemenu-add-face-function (face _end)
- (let ((tag-face (cdr (assq face sgml-face-tag-alist))))
+ "Add \"face\" tags with `facemenu-keymap' commands."
+ (let ((tag-face (ensure-list (cdr (assq face sgml-face-tag-alist)))))
(cond (tag-face
(setq tag-face (funcall skeleton-transformation-function tag-face))
- (setq facemenu-end-add-face (concat "</" tag-face ">"))
- (concat "<" tag-face ">"))
+ (setq facemenu-end-add-face
+ (mapconcat (lambda (f) (concat "</" f ">")) (reverse tag-face) ""))
+ (mapconcat (lambda (f) (concat "<" f ">")) tag-face ""))
((and (consp face)
(consp (car face))
(null (cdr face))
@@ -620,6 +624,7 @@ Do \\[describe-key] on the following bindings to discover what they do.
(setq-local comment-indent-function 'sgml-comment-indent)
(setq-local comment-line-break-function 'sgml-comment-indent-new-line)
(setq-local skeleton-further-elements '((completion-ignore-case t)))
+ (setq-local skeleton-end-newline nil)
(setq-local skeleton-end-hook
(lambda ()
(or (eolp)
@@ -1868,6 +1873,7 @@ This takes effect when first loading the library.")
(defvar html-face-tag-alist
'((bold . "strong")
(italic . "em")
+ (bold-italic . ("strong" "em"))
(underline . "u")
(mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
@@ -2411,6 +2417,8 @@ To work around that, do:
(setq-local css-id-list-function #'html-current-buffer-ids))
(setq imenu-create-index-function 'html-imenu-index)
+ (yank-media-handler 'text/html #'html-mode--html-yank-handler)
+ (yank-media-handler "image/.*" #'html-mode--image-yank-handler)
(setq-local sgml-empty-tags
;; From HTML-4.01's loose.dtd, parsed with
@@ -2426,6 +2434,30 @@ To work around that, do:
;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose
)
+(defun html-mode--html-yank-handler (_type html)
+ (save-restriction
+ (insert html)
+ (ignore-errors
+ (sgml-pretty-print (point-min) (point-max)))))
+
+(defun html-mode--image-yank-handler (type image)
+ (let ((file (read-file-name (format "Save %s image to: " type))))
+ (when (file-directory-p file)
+ (user-error "%s is a directory"))
+ (when (and (file-exists-p file)
+ (not (yes-or-no-p (format "%s exists; overwrite?" file))))
+ (user-error "%s exists"))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (write-region (point-min) (point-max) file))
+ (insert (format "<img src=%S>\n" (file-relative-name file)))
+ (insert-image
+ (create-image file (mailcap-mime-type-to-extension type) nil
+ :max-width 200
+ :max-height 200)
+ " ")))
+
(defvar html-imenu-regexp
"\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
"A regular expression matching a head line to be added to the menu.