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

   1 ;;; psgml-ids.el --- Management of ID/IDREFS for PSGML
   2 ;; $Id: psgml-ids.el,v 2.1 2005/02/09 15:29:09 lenst Exp $
   3
   4 ;; Copyright (C) 1999 Jean-Daniel Fekete
   5
   6 ;; Author: Jean-Daniel Fekete <Jean-Daniel.Fekete@emn.fr>
   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 \f
  22 ;;; Commentary:
  23
  24 ;; Provides some extra functions to manage IDs and IDREFs in attibutes
  25
  26 \f
  27 (provide 'psgml-ids)
  28 (require 'psgml)
  29 (require 'psgml-api)
  30
  31 \f
  32 (defvar sgml-record-id-p t
  33   "Set to non-nil, if you want to record all referenced IDS for completion.")
  34
  35 (defvar sgml-id-list nil
  36   "List of IDs available for completing IDREFs")
  37 ;(make-variable-buffer-local 'sgml-id-list)
  38
  39 (defvar sgml-id-alist nil
  40   "Alist of IDs available for completing IDREFs")
  41
  42 (defvar sgml-id-list-sorted-p nil
  43   "Set to T when the sgml-id-list is sorted")
  44
  45 (defvar sgml-edit-idrefs-map
  46   (let ((map (make-sparse-keymap 'sgml-edit-idrefs-map)))
  47     (set-keymap-parent map minibuffer-local-completion-map)
  48     (define-key map " " 'self-insert-command)
  49     map))
  50
  51 \f
  52 (defun sgml-id-list ()
  53   (unless sgml-id-list-sorted-p
  54     (setq sgml-id-list (sort sgml-id-list #'string-lessp)
  55           sgml-id-list-sorted-p t
  56           sgml-id-alist nil))
  57   sgml-id-list)
  58
  59 (defun sgml-id-alist ()
  60   (unless sgml-id-alist
  61     (setq sgml-id-alist (mapcar #'(lambda (id) (cons id id)) (sgml-id-list))))
  62   sgml-id-alist)
  63
  64 (defun sgml-add-id (id)
  65   (unless (or (not sgml-record-id-p) (member id sgml-id-list))
  66     (push id sgml-id-list)
  67     (setq sgml-id-list-sorted-p nil)))
  68
  69 (defun sgml-ids-add-from (element)
  70   "Find of all attributes of type ID in ELEMENT and add their value to the
  71 sgml-id-list."
  72   (let ((asl (sgml-element-attribute-specification-list element))
  73         (adl (sgml-element-attlist element)))
  74
  75     (dolist (as asl)
  76       (let* ((aname (sgml-attspec-name as))
  77              (value (sgml-attspec-attval as))
  78              (dcl-value (sgml-attdecl-declared-value
  79                          (sgml-lookup-attdecl aname adl))))
  80         (if (and (eq dcl-value 'ID)
  81                  value)
  82             (sgml-add-id value))))))
  83
  84
  85 (defun sgml-ids-add-current ()
  86   (interactive)
  87   (sgml-ids-add-from (sgml-find-context-of (point))))
  88
  89 (defun sgml-ids-add-all (&optional element)
  90   "Find all the ids of elements inside ELEMENT or the top element if not
  91 specified"
  92   (interactive)
  93   (let ((el (or element (sgml-top-element))))
  94     (sgml-map-element-modify (function sgml-ids-add-from) el)))
  95