PSGML Tricks

Bob DuCharme bob@snee.com
www.snee.com/bob
Last updated 2005-10-17

Lennart Staflin's PSGML is an add-in to the Emacs text editor that makes it a menu-driven, validating SGML/XML editor. You can download an Acrobat file of a tutorial on using Emacs and PSGML from the web page for my book SGML CD, a tutorial and user's guide to free SGML/XML software. (The tutorial, which is a chapter from that book, assumes no knowledge of Emacs; the book's Web page has further information on getting and installing the software.)

All of these "tricks" consist of new lines for an .emacs file to automate or ease certain steps when using PSGML to edit SGML and XML files.

Shameless Plug: buy my Annotated XML Specification, available from Prentice Hall PTR.

Notes
Making Your Customizations Only Work in SGML Mode
Automating Entry of ISO Entity References
Colors
DocBook Related
Several from Christian Lemburg
Several from Ulrich Deiters
Miscellaneous

Notes

Send me yours! I'll credit all contributions. E-mail me with small, self-contained pieces of code with a comment or two in them.
Please feel free to suggest improvements to the code inefficiencies you see. They're certainly there.
^Co refers to pressing ^C followed by the o key.
When I assign a keystroke, I try to start it with ^C to be consistent with other PSGML keystrokes.
To display ^C on this web page, I entered "^" followed by "C", so if you copy the code directly into your .emacs file, remember to replace those two characters with the single ^C character. (Use Emacs' quoted-insert command, ^Q, to enter it: ^Q^C.)
Boris Tobotras's .emacs file has a lot of good stuff, especially TEI-related.
If you're an Emacs & (SGML | XML) person, see also Daniel Spec's Emacs Omnimark Major Mode and Tony Graham's Emacs DTD mode.

Making Your Customizations Only Work in SGML Mode

If you assign a keystroke to do do something in SGML mode, it's nice to leave that keystroke for other uses in other modes. For example, I like to create a new comment with ^Co. In SGML mode, I want this to enter "" and then move the cursor four characters to the left, but I don't want ^Co to do the same thing when I'm editing a Perl script, so I put SGML-specific stuff inside the following code:

(add-hook 'sgml-mode-hook   ; make all this stuff SGML-specific
(function (lambda()
              ; everything in here will only apply in SGML mode
)))

Automating Entry of ISO Entity References

(My thanks to Chris Maden for pointing out that I forgot to use & instead of & in this section's entity references, so they didn't appear correctly in browsers.)

Em Dash

I use em dashes too much. ^C- may seem like a more intuitive keystroke, but PSGML already uses it for sgml-untag-element.

(defun sgml-emdash ()
   "Insert ISO entity reference for em dash."
   (interactive)
   (insert "&mdash;"))

(define-key sgml-mode-map "^C_" 'sgml-emdash)

Less-Than

(defun sgml-lt ()
   "Insert ISO entity reference for less-than."
   (interactive)
   (insert "&lt;"))

(define-key sgml-mode-map "^C<" 'sgml-lt)

Non-Breaking Space

(defun sgml-nbsp ()
   "Insert ISO entity reference for non-breaking space."
   (interactive)
   (insert "&nbsp;"))

(define-key sgml-mode-map "\e " 'sgml-nbsp)

Colors

I have two sets of color settings, depending on whether I'm going to do screen shots for use in a one-color printed book. Near the top of my .emacs file I have the following line to pick which setting to use:

(setq screenshots nil)   ; t for screenshot color settings, else nil

For more coloring tricks, see:

The DocBook section of this document.
Boris Tobotras's .emacs file.

(make-face 'sgml-comment-face)
(make-face 'sgml-start-tag-face)
(make-face 'sgml-end-tag-face)
(make-face 'sgml-entity-face)
(make-face 'sgml-doctype-face)

(cond ((equal screenshots nil)   
   (set-face-foreground 'sgml-comment-face "FireBrick")
   (set-face-foreground 'sgml-start-tag-face "SlateBlue")
   (set-face-foreground 'sgml-end-tag-face "SlateBlue")
   (set-face-background 'sgml-entity-face "SlateBlue")
   (set-face-foreground 'sgml-entity-face "Red")
   (set-face-foreground 'sgml-doctype-face "FireBrick")
  )
  ((equal screenshots t)
   ; This set for screen shots
   (set-background-color "White")
   (set-face-foreground 'sgml-comment-face "White")  ; Comments: white on
   (set-face-background 'sgml-comment-face "Gray")   ; gray. 
   (set-face-background 'sgml-start-tag-face "Gray") ; Tags: black (default)
   (set-face-background 'sgml-end-tag-face "Gray")   ; on gray.
   (set-face-foreground 'sgml-entity-face "White")   ; Entity references:
   (set-face-background 'sgml-entity-face "Black")   ; white on black. 
  )
(t nil))

(setq sgml-set-face t)  ; without this, all SGML text is in same color
(setq sgml-markup-faces
   '((comment   . sgml-comment-face)
     (start-tag . sgml-start-tag-face)
     (end-tag   . sgml-end-tag-face)
     (doctype   . sgml-doctype-face)
     (entity    . sgml-entity-face)))

DocBook Related

These automate the entry of entries that I use the most often. See the DocBook Documentation for more on DocBook.

You might also be interested in Norm Walsh's DocBook IDE.

Insert `para` Element

(defun sgml-para ()
   "Insert para tags and position cursor."
   (interactive)
   (sgml-insert-element 'para))
(define-key sgml-mode-map "^Cp" 'sgml-para)

Insert `literal` Element

(defun sgml-literal ()
   "Insert literal element."
   (interactive)
   (sgml-insert-element 'literal))
(define-key sgml-mode-map "\C-c\l" 'sgml-literal)

Insert `glossterm` Element

(defun sgml-glossterm ()
   "Insert glossterm element."
   (interactive)
   (sgml-insert-element 'glossterm))
(define-key sgml-mode-map "^C^T" 'sgml-glossterm)

Tag Marked Region as an `emphasis` Element

Note that it assumes your cursor is at the end of the region to tag.

(defun emph-tag ()
  "Tag marked region as an emphasis element (assumes cursor at region end)."
  (interactive)
  (insert "</emphasis>")
  (goto-char (mark))
  (insert "<emphasis>")
  (sgml-next-data-field)
)
(define-key sgml-mode-map "\ee" 'emph-tag)

Inserting Index Tags

This greatly speeds up index tagging. Just mark the region to add as an index tag and press ^Cx. If you want to add a secondary value, press ^Cy and enter that value.

The first one copies the currently marked region and makes it the primary value of an index entry. The second assumes that the cursor is at the end of the primary element's content (that is, it's on the < in the </primary> tag).

(defun index-tag ()
  "Copy marked section to a primary index tag for it."
  (interactive)
  (kill-ring-save (point)(mark))
  (sgml-insert-element 'indexterm)
  (sgml-insert-element 'primary)
  (yank))
(define-key sgml-mode-map "^Cx" 'index-tag)

(defun index-tag-sec ()
"Add secondary index element. Assumes cursor at end of primary element content."
(interactive)
  (sgml-next-data-field)
  (sgml-insert-element 'secondary))
(define-key sgml-mode-map "^Cy" 'index-tag-sec)

Coloring Index Elements

The following sets the content of index-related elements to the comment-face color. I'll reset this color to something that blends in or stands out from the background depending on whether I'm working on the index entries or not.

(defvar sgml-font-lock-keywords  
  '(; Highlight the text between these tags in SGML mode.
      ("<indexterm[^>]*>" . font-lock-comment-face) 
      ("</indexterm>" . font-lock-comment-face) 
      ("<primary[^<]+</primary>" . font-lock-comment-face) 
      ("<secondary[^<]+</secondary>" . font-lock-comment-face) 
      ("<see[^<]+</see>" . font-lock-comment-face) 
      ("<seealso[^<]+</seealso>" . font-lock-comment-face) 
   )
  "Additional expressions to highlight in SGML mode.")

  (setq font-lock-defaults '(sgml-font-lock-keywords t))

Insert `sgmltag` Element for an Element Type Name

(defun sgml-elname ()
   "Insert sgmltag element for an element type name."
   (interactive)
   (insert "<sgmltag class=\"element\"></sgmltag>")
   (backward-char 10))
(define-key sgml-mode-map "^Ce" 'sgml-elname)

Insert `sgmltag` Element for an Attribute Type Name

(defun sgml-atname ()
   "Insert sgmltag element for an attribute name."
   (interactive)
   (insert "<sgmltag class=\"attribute\"></sgmltag>")
   (backward-char 10))
(define-key sgml-mode-map "^Ca" 'sgml-atname)

Automate Entry of Acronyms

Mark Eichin <eichin@thok.org> sent this handy trick for using Emacs completion for your own acronyms and automating their tagging with acronym tags. He writes:

I haven't gone much further with this, but it can be useful when you're doing acronym-heavy writing (like IETF work :-) Isn't really docbook specific, anything with an <acronym> tag would be fine.

It should automatically create a .acronym file, but a simple one would look like this:
(setq acronym-completion-table '(("FIPS") ("CPU") ("DES") ("RAM") ("FTP") ("SMTP")))
It *should* work such that you just start using it, and fill in acronyms as you use them, and when you exit emacs (or hit c-x s) it prompts you to save the buffer. I haven't actually tried it with emacs20, come to think of it, but it should work...

;;; docbook acronym insertion tool.
;;; Copyright 1997, Mark W. Eichin, Cygnus Solutions.
;;; Author: Mark Eichin <eichin@cygnus.com>
;;; Maintainer: Mark Eichin <eichin@cygnus.com>
;;; Keywords: languages sgml
;;; Release: 0.1
;;; GNU General Public License V2 applies.

;;; I found myself doing some technical writing that uses a lot of acronyms.
;;; Even with psgml-mode, it was a little cumbersome.  This code 
;;;    1) maintains a database of known acronyms in ~/.acronym (for completion)
;;;    2) inserts <acronym></acronym> tags
;;;    3) upcases the acronyms
;;; It binds itself to c-c . in sgml-mode-map.

(require 'psgml)

(defvar acronym-file "~/.acronym"
  "Completion list of acronyms")
(if (null (load acronym-file t t t))
    (setq acronym-completion-table (list (list "FTP") (list "SMTP"))))
(setq acroynm-buffer (find-file-noselect acronym-file))
(setq acronym-history-list nil)
(defun docbook-insert-acronym (acronym)
  "Insert ACRONYM inside docbook <acronym> tags, with completion.  A list of
known acronyms is maintained in acronym-file."
  (interactive
   (list 
    (let ((completion-ignore-case t))
      (upcase 
       (completing-read "Acronym: " acronym-completion-table
			nil nil		;pred req-match 
			nil 'acronym-history-list)))))
  (let ((sgml-balanced-tag-edit nil))
    (sgml-insert-tag "<acronym>")
    (insert acronym)
    (sgml-insert-end-tag))
  
  (if (null (assoc acronym acronym-completion-table))
      (save-excursion
	(setq acronym-completion-table (append (list (list acronym))
					     acronym-completion-table))
	(set-buffer acroynm-buffer)
	(erase-buffer)
	(insert "(setq acronym-completion-table '"
		(prin1-to-string acronym-completion-table)
		")\n")
	))
)
(define-key sgml-mode-map "\C-c."    'docbook-insert-acronym)

Several from Christian Lemburg

(defun my-docbook-linkref ()
  "Wrap region inside a link tag with a linkend attribute that corresponds to region, 
   and position point after the end of the link tag."
  (interactive)
    (save-restriction
      (narrow-to-region (region-beginning) (region-end))
      (let ((start "<link linkend=\"")
          (middle "\">")
	      (end "</link>")
	          (object (my-clean-idref (buffer-substring (region-beginning) (region-end)))))
      (goto-char (point-min))
      (insert start)
      (insert object)
      (insert middle)
      (goto-char (point-max))
      (insert end))))

(defun my-docbook-linkref-word (&optional count)
  "Wrap word(s) before or around point inside a link tag with a
linkend attribute that corresponds to word(s). Prefix arg determines
number of words."
  (interactive "p")
  (my-forward-word-pos -1) 
  (if count
      (mark-word count)
    (mark-word 1))
  (my-docbook-linkref))

(defun my-clean-idref (idref-input)
  "Return a string corresponding to IDREF-INPUT, but without
characters disallowed in SGML IDREF attributes."
  (replace-in-string 
   (replace-in-string 
    (apply #'concat (mapcar #'upcase-initials (split-string idref-input))) 
    "[^a-zA-Z0-9]" "-") 
   "^\\([0-9]+\\)" "X\\1"))

(defun my-forward-word-pos (count)
  (progn
    (forward-word count)
    (point)))


(defun my-biblioentry (title subtitle publisher pubdate)
  "Query for and insert docbook bibliography entry data."
  (interactive "sTitle: \nsSubtitle: \nsPublisher: \nsPublication Date: ")
  (let ((firstname (read-string "Author Firstname: "))
  (surname (read-string "Author Surname: "))
  (count 0)
  (authors ""))
    (while (my-valid-string-p (concat firstname surname))
      (incf count)
      (setq authors (my-nconc-authors authors firstname surname))
      (setq firstname (read-string "Author Firstname: "))
      (setq surname (read-string "Author Surname: ")))
    (let ((author-string (my-make-authors-string authors count))
      (id (my-clean-biblioentry-title title))
        (title-string (my-make-titles-string title subtitle))
	  (publication (my-make-publication-string publisher pubdate))
	    (abstract (my-make-abstract)))
      (my-print-biblioentry id title-string author-string 
          publication abstract))))

(defun my-clean-biblioentry-title (title)
  "Replace non-IDREF characters in title."
  (replace-in-string 
   (replace-in-string 
    (apply #'concat (mapcar #'upcase-initials (split-string title))) 
    "[^a-zA-Z0-9]" "-") 
   "^\\([0-9]+\\)" "X\\1"))

(defun my-nconc-authors (authors firstname surname)
  (setq authors 
  (concat authors 
  (concat "<author>\n"
  (when (my-valid-string-p firstname)
    (concat "<firstname>" firstname "</firstname>\n"))
    (when (my-valid-string-p surname)
      (concat "<surname>" surname "</surname>\n"))
      "</author>\n"))))

(defun my-make-authors-string (authors count)
  (if (> count 1)
      (concat "<authorgroup>\n" authors "</authorgroup>\n")
    authors))

(defun my-make-abstract ()
  (let* ((abstract "<abstract>\n")
  (count 1)
  (para (read-string (concat "Paragraph " 
      (int-to-string count) ": "))))
    (while (my-valid-string-p para)
      (incf count)
      (setq abstract (concat abstract "<para>\n" para "\n</para>\n"))
      (setq para (read-string (concat "Paragraph " 
            (int-to-string count) ": "))))
    (concat abstract "</abstract>\n")))

(defun my-make-titles-string (title subtitle)
  (concat "<title>" title "</title>\n"
    (when (not (string-equal "" subtitle))
        (concat "<subtitle>" subtitle "</subtitle>\n"))))

(defun my-make-publication-string (publisher pubdate)
  (concat "<publisher><publishername>" 
    publisher
      "</publishername></publisher>\n"
        "<pubdate>"
	  pubdate
	    "</pubdate>\n"))

(defun my-valid-string-p (s)
  (not (string-equal "" s)))

(defun my-print-biblioentry (id titles authors publication abstract)
  (insert (format "<biblioentry id=\"%s\">\n" id)
    titles authors publication abstract
      "</biblioentry>\n\n"))

;; in PSGML, the M-C-* family of movement commands is very useful,
;; but hard to type due to M-C combination, therefore

;; make SUPER key act as M-C
;; note that SUPER is default for useless Win flag key on some Linux platforms

(defun my-add-super-key-as-meta-control (keymap)
  (map-keymap 
   #'(lambda (description binding) 
       (if (and (consp description)
       (member 'meta description)
       (member 'control description))
          (let ((specifier-keys (remove 'control 
	  (remove 'meta description))))
	       (define-key keymap (cons 'super specifier-keys) binding))))
   keymap))

(defun my-add-super-key-as-meta-control-to-all-current-keymaps ()
  (interactive)
  (mapcar #'my-add-super-key-as-meta-control (current-keymaps)))

(my-add-super-key-as-meta-control-to-all-current-keymaps)

Several from Ulrich Deiters

I am using PSGML for scientific typesetting and diagram production, i.e., I am using XEmacs/PSGML for writing, translate SGML to LaTeX, then to DVI and PostScript. This way I have a scientific editor with menu support *and* superior output quality.

The drawback with XEmacs is that one can accidentally write over SGML tags and thus produce a faulty document. The scripts below are some protection against this: When the cursor is moved with the arrow keys, it jumps over tags.

(defun sgml-safe-right()
 "move forward, skipping over tags"
 (interactive)
 (forward-char)
 (setq actpos (point))
 (sgml-end-of-element)
 (setq endpos (point))
 (sgml-beginning-of-element)
 (setq begpos (point))
 (if (>= actpos begpos)
  (goto-char actpos))
 (if (>= actpos endpos)
  (sgml-up-element))
)
(define-key sgml-mode-map [(right)] 'sgml-safe-right)

(defun sgml-safe-left()
 "move backward, skipping over tags"
 (interactive)
 (backward-char)
 (setq actpos (point))
 (sgml-beginning-of-element)
 (setq begpos (point))
 (sgml-end-of-element)
 (setq endpos (point))
 (if (< actpos endpos)
  (goto-char actpos))
 (if (< actpos begpos)
  (sgml-backward-up-element))
)
(define-key sgml-mode-map [(left)] 'sgml-safe-left)


(defun sgml-safe-down()
 "move downward, skipping over tags"
 (interactive)
 (next-line 1)
 (setq actpos (point))
 (sgml-end-of-element)
 (setq endpos (point))
 (sgml-beginning-of-element)
 (setq begpos (point))
 (if (>= actpos begpos)
  (goto-char actpos))
 (if (>= actpos endpos)
  (sgml-up-element))
)
(define-key sgml-mode-map [(down)] 'sgml-safe-down)

(defun sgml-safe-up()
 "move upward, skipping over tags"
 (interactive)
 (previous-line 1)
 (setq actpos (point))
 (sgml-beginning-of-element)
 (setq begpos (point))
 (sgml-end-of-element)
 (setq endpos (point))
 (if (< actpos endpos)
  (goto-char actpos))
 (if (< actpos begpos)
  (sgml-backward-up-element))
)
(define-key sgml-mode-map [(up)] 'sgml-safe-up)

Miscellaneous

Edit Element Attributes by Right-Clicking Mouse

This is my favorite. They can take away my command line when they pry it out of my cold dead hand, but I've gotten used to editing object attributes in other software from a menu that I pop up by right-clicking a selected object, and now I can do it in PSGML.

; right-click selected element for edit attributes popup
(define-key sgml-mode-map [mouse-3] 'sgml-attrib-menu)

Jump Cursor to Beginning or End of Element

PSGML assigns these commands to the Esc ^A and Esc ^E keystrokes, but I find ^C home and ^C end easier to remember.

(global-set-key [?\C-c (home)] 'sgml-beginning-of-element)

(global-set-key [?\C-c (end)] 'sgml-end-of-element)

Add a Comment

(defun sgml-comment ()
   "Insert SGML comment and position cursor."
   (interactive)
   (insert "<!--  -->")
   (backward-char 4))

(define-key sgml-mode-map "^Co" 'sgml-comment)

Add an IGNORE Marked Section

(defun sgml-ignore ()
   "Insert an IGNORE marked section."
   (interactive)
   (insert "<![IGNORE[
]]>
"))
(define-key sgml-mode-map "\C-c\i" 'sgml-ignore)

Kill Text from Cursor to End of Element

(defun sgml-kill-to-eoelement ()  
  "Kill to end of element."
  (interactive)
  (let ((start (point)))
  (sgml-end-of-element)
  (kill-region start (point))))

(define-key sgml-mode-map "^Ck" 'sgml-kill-to-eoelement)

Copy Current Element to Buffer

(defun sgml-copy-element ()
  "Copy the current element to the buffer."
  (interactive)
  (sgml-backward-up-element)
  (let ((start (point)))
  (sgml-forward-element)
  (kill-ring-save start (point))))

(define-key sgml-mode-map "^Cw" 'sgml-copy-element)

Fill Element and Save File

sgml-fill-element is PSGML's SGML-intelligent way to rejustify an element. After making edits to a paragraph, I like to hit one keystroke (F2) to rejustify the element and save my work.

(defun sgml-fill-and-save ()
  "Rejustify element at cursor and save file."
  (interactive)
  (sgml-fill-element (sgml-find-element-of (point)))   ; see psgml-edit.el
  (save-buffer))

(define-key sgml-mode-map [f2] 'sgml-fill-and-save)

Generate Document Outline for Navigation

Jens Emmerich sent in http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/docbook/contrib/tools/emacs/doctoc, which "uses PSGML's (or an external) parse tree to generate a document outline from which you can jump to the respective document locations. Not really a snippet, but very useful for navigation within big documents."