diff options
Diffstat (limited to 'emacs.d/elisp/muse/muse-xml-common.el')
| -rw-r--r-- | emacs.d/elisp/muse/muse-xml-common.el | 201 |
1 files changed, 0 insertions, 201 deletions
diff --git a/emacs.d/elisp/muse/muse-xml-common.el b/emacs.d/elisp/muse/muse-xml-common.el deleted file mode 100644 index 75869ca..0000000 --- a/emacs.d/elisp/muse/muse-xml-common.el +++ /dev/null @@ -1,201 +0,0 @@ -;;; muse-xml-common.el --- common routines for XML-like publishing styles - -;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. - -;; This file is part of Emacs Muse. It is not part of GNU Emacs. - -;; Emacs Muse 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 3, or (at your -;; option) any later version. - -;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Contributors: - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Muse XML Publishing - Common Elements -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'muse-publish) -(require 'muse-regexps) - -(defcustom muse-xml-encoding-map - '((iso-8859-1 . "iso-8859-1") - (iso-2022-jp . "iso-2022-jp") - (utf-8 . "utf-8") - (japanese-iso-8bit . "euc-jp") - (chinese-big5 . "big5") - (mule-utf-8 . "utf-8") - (chinese-iso-8bit . "gb2312") - (chinese-gbk . "gbk")) - "An alist mapping Emacs coding systems to appropriate XML charsets. -Use the base name of the coding system (i.e. without the -unix)." - :type '(alist :key-type coding-system :value-type string) - :group 'muse-xml) - -(defun muse-xml-transform-content-type (content-type default) - "Using `muse-xml-encoding-map', try and resolve an Emacs coding -system to an associated XML coding system. -If no match is found, the DEFAULT charset is used instead." - (let ((match (and (fboundp 'coding-system-base) - (assoc (coding-system-base content-type) - muse-xml-encoding-map)))) - (if match - (cdr match) - default))) - -(defcustom muse-xml-markup-specials - '((?\" . """) - (?\< . "<") - (?\> . ">") - (?\& . "&")) - "A table of characters which must be represented specially." - :type '(alist :key-type character :value-type string) - :group 'muse-xml) - -(defcustom muse-xml-markup-specials-url-extra - '((?\" . """) - (?\< . "<") - (?\> . ">") - (?\& . "&") - (?\ . "%20") - (?\n . "%0D%0A")) - "A table of characters which must be represented specially. -These are extra characters that are escaped within URLs." - :type '(alist :key-type character :value-type string) - :group 'muse-xml) - -(defun muse-xml-decide-specials (context) - "Determine the specials to escape, depending on CONTEXT." - (cond ((memq context '(email url image)) - 'muse-xml-escape-url) - ((eq context 'url-extra) - muse-xml-markup-specials-url-extra) - (t muse-xml-markup-specials))) - -(defun muse-xml-escape-url (str) - "Convert to character entities any non-alphanumeric characters -outside a few punctuation symbols, that risk being misinterpreted -if not escaped." - (when str - (setq str (muse-publish-escape-specials-in-string str 'url-extra)) - (let (pos code len ch) - (save-match-data - (while (setq pos (string-match (concat "[^-" - muse-regexp-alnum - "/:._=@\\?~#%\"\\+<>()&;]") - str pos)) - (setq ch (aref str pos) - code (concat "&#" (int-to-string - (cond ((fboundp 'char-to-ucs) - (char-to-ucs ch)) - ((fboundp 'char-to-int) - (char-to-int ch)) - (t ch))) - ";") - len (length code) - str (concat (substring str 0 pos) - code - (when (< pos (length str)) - (substring str (1+ pos) nil))) - pos (+ len pos))) - str)))) - -(defun muse-xml-markup-anchor () - (unless (get-text-property (match-end 1) 'muse-link) - (let ((text (muse-markup-text 'anchor (match-string 2)))) - (save-match-data - (skip-chars-forward (concat muse-regexp-blank "\n")) - (when (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>")) - (goto-char (match-end 0))) - (muse-insert-markup text))) - (match-string 1))) - -(defun muse-xml-sort-table (table) - "Sort the given table structure so that it validates properly." - ;; Note that the decision matrix must have a nil diagonal, or else - ;; elements with the same type will be reversed with respect to each - ;; other. - (let ((decisions '((nil nil nil) ; body < header, body < footer - (t nil t) ; header stays where it is - (t nil nil)))) ; footer < header - (sort table #'(lambda (l r) - (and (integerp (car l)) (integerp (car r)) - (nth (1- (car r)) - (nth (1- (car l)) decisions))))))) - -(defun muse-xml-markup-table (&optional attributes) - "Publish the matched region into a table. -If a string ATTRIBUTES is given, pass it to the markup string begin-table." - (let* ((table-info (muse-publish-table-fields (match-beginning 0) - (match-end 0))) - (row-len (car table-info)) - (supports-group (not (string= (muse-markup-text 'begin-table-group - row-len) - ""))) - (field-list (muse-xml-sort-table (cdr table-info))) - last-part) - (when table-info - (let ((beg (point))) - (muse-publish-ensure-block beg)) - (muse-insert-markup (muse-markup-text 'begin-table (or attributes ""))) - (muse-insert-markup (muse-markup-text 'begin-table-group row-len)) - (dolist (fields field-list) - (let* ((type (car fields)) - (part (cond ((eq type 'hline) nil) - ((= type 1) "tbody") - ((= type 2) "thead") - ((= type 3) "tfoot"))) - (col (cond ((eq type 'hline) nil) - ((= type 1) "td") - ((= type 2) "th") - ((= type 3) "td")))) - (setq fields (cdr fields)) - (unless (and part last-part (string= part last-part)) - (when last-part - (muse-insert-markup " </" last-part ">\n") - (when (eq type 'hline) - ;; horizontal separators are represented by closing - ;; the current table group and opening a new one - (muse-insert-markup (muse-markup-text 'end-table-group)) - (muse-insert-markup (muse-markup-text 'begin-table-group - row-len)))) - (when part - (muse-insert-markup " <" part ">\n")) - (setq last-part part)) - (unless (eq type 'hline) - (muse-insert-markup (muse-markup-text 'begin-table-row)) - (dolist (field fields) - (muse-insert-markup (muse-markup-text 'begin-table-entry col)) - (insert field) - (muse-insert-markup (muse-markup-text 'end-table-entry col))) - (muse-insert-markup (muse-markup-text 'end-table-row))))) - (when last-part - (muse-insert-markup " </" last-part ">\n")) - (muse-insert-markup (muse-markup-text 'end-table-group)) - (muse-insert-markup (muse-markup-text 'end-table)) - (insert ?\n)))) - -(defun muse-xml-prepare-buffer () - (set (make-local-variable 'muse-publish-url-transforms) - (cons 'muse-xml-escape-string muse-publish-url-transforms))) - -(provide 'muse-xml-common) - -;;; muse-xml-common.el ends here |