cgit.sxemacs.org Git - packages/blob - xemacs-packages/psgml/psgml-api.el

   1 ;;; psgml-api.el --- Extra API functions for PSGML
   2 ;; $Id: psgml-api.el,v 1.8 2002/04/25 20:50:27 lenst Exp $
   3
   4 ;; Copyright (C) 1994 Lennart Staflin
   5
   6 ;; Author: Lennart Staflin <lenst@lysator.liu.se>
   7
   8 ;; This program is free software; you can redistribute it and/or
   9 ;; modify it under the terms of the GNU General Public License
  10 ;; as published by the Free Software Foundation; either version 2
  11 ;; of the License, or (at your option) any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program; if not, write to the Free Software
  20 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 \f
  23 ;;; Commentary:
  24
  25 ;; Provides some extra functions for the API to PSGML.
  26
  27 \f
  28 ;;; Code:
  29
  30 (provide 'psgml-api)
  31 (require 'psgml)
  32 (require 'psgml-parse)
  33 (eval-when-compile (require 'cl))
  34 \f
  35 ;;;; Mapping: map and modify
  36
  37 (defun sgml-map-element-modify (el-fun element)
  38   "Apply EL-FUN to ELEMENT and the elements in its content.
  39 The EL-FUN may change the buffer.  But if it changes the buffer and
  40 leaves the element with no start-tag some elements may be ignored."
  41   (let ((level                          ; level in the element tree
  42          0)
  43         next
  44         (tick                           ; change counter
  45          (buffer-modified-tick)))
  46     (while element
  47       (funcall el-fun element)
  48       ;; If the function has modified the buffer, a fresh parse is needed
  49       (when (/= tick (buffer-modified-tick))
  50         (setq element (sgml-find-element-of (sgml-element-start element)))
  51         (setq tick (buffer-modified-tick)))
  52       (cond
  53        ;; Map content if any
  54        ((setq next (sgml-element-content element))
  55         (incf level))
  56        ;; If in a sub-tree, move to next element
  57        (t
  58         (while (and (> level 0)
  59                     (null (setq next (sgml-element-next element))))
  60           (setq element (sgml-element-parent element))
  61           (decf level))))
  62       (setq element next))))
  63 \f
  64 ;;;; Map content
  65
  66 (defun sgml-map-content (element element-fun
  67                                  &optional data-fun pi-fun entity-fun)
  68   "Map content of ELEMENT, calling ELEMENT-FUN for every element.
  69 Also calling DATA-FUN, if non-nil, with data in content."
  70   (sgml-pop-all-entities)
  71   (sgml-need-dtd)
  72   (sgml-element-end element)            ; Make sure all content is parsed
  73   (unless (sgml-element-empty element)
  74     (let ((main-buffer-max (point-max)))
  75       (save-excursion
  76         (sgml-with-parser-syntax-ro
  77          (sgml-set-parse-state element 'start)
  78          (when (eobp) (sgml-pop-entity))
  79          (when (eolp) (forward-char 1))
  80          (sgml-parse-data main-buffer-max data-fun pi-fun entity-fun)
  81          (let ((c (sgml-tree-content element)))
  82            (while c
  83              (sgml-pop-all-entities)
  84              (funcall element-fun c)
  85              (sgml-set-parse-state c 'after)
  86              (sgml-parse-data main-buffer-max data-fun pi-fun entity-fun)
  87              (setq c (sgml-tree-next c)))))))))
  88
  89 (defun sgml-parse-data (sgml-goal sgml-data-function sgml-pi-function
  90                                   sgml-entity-function)
  91   (let ((sgml-throw-on-element-change 'el-done))
  92     (catch sgml-throw-on-element-change
  93       (sgml-parse-continue sgml-goal nil t))))
  94
  95 \f
  96 ;;;; Entity management
  97
  98 (defun sgml-push-to-string (string)
  99   "Create an entity from STRING and push it on the top of the entity stack.
 100 After this the current buffer will be a scratch buffer containing the text
 101 of the new entity with point at the first character.
 102     Use `sgml-pop-entity' to exit from this buffer."
 103   (sgml-push-to-entity (sgml-make-entity "#STRING" 'text string)))
 104
 105
 106 \f
 107 ;;; psgml-api.el ends here