[elpa] scratch/psgml a50afae: * psgml-ids.el: Remove, for lack of copyright paperwork

[Stefan Monnier]

branch: scratch/psgml
commit a50afaee57d7945b69d803988a5fe8951d05846e
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * psgml-ids.el: Remove, for lack of copyright paperwork
    
    Most of it was not really used; for the rest, reimplement it differently.
    
    * psgml-parse.el (psgml-ids-seen): New var.
    (sgml-parse-attribute-specification-list): Use it instead of sgml-add-id.
    
    * psgml-edit.el: Don't require psgml-ids any more.
    (psgml-edit--read-ids): New function, using completing-read-multiple.
    (sgml-read-attribute-value): Use it along with psgml-ids-seen.
    (sgml-idrefs-completer): Remove function.
---
 TODO           |    1 -
 psgml-edit.el  |   46 +++++++++++++--------------
 psgml-ids.el   |   95 --------------------------------------------------------
 psgml-maint.el |    5 ++-
 psgml-parse.el |    9 +++---
 5 files changed, 28 insertions(+), 128 deletions(-)

diff --git a/TODO b/TODO
index 485649d..b3028de 100644
--- a/TODO
+++ b/TODO
@@ -4,7 +4,6 @@ TODO                 -*- outline -*-
 ** Use a keymap filter for sgml-update-options-menu?
 ** Get rid of (redundant) invisible handling in sgml-update-display.
 ** Make psgml-mode derive from sgml-mode.el?
-** Upgrade to GPLv3+
 ** Figure out what sgml-attr-clean-and-insert does.
 ** Fix interaction with font-lock.
 ** Generate internal autoloads (at end of psgml.el) automatically.
diff --git a/psgml-edit.el b/psgml-edit.el
index 7ad7d52..7300612 100644
--- a/psgml-edit.el
+++ b/psgml-edit.el
@@ -1,6 +1,6 @@
 ;;; psgml-edit.el --- Editing commands for SGML-mode with parsing support  -*- 
lexical-binding:t -*-
 
-;; Copyright (C) 1994-1996, 2016  Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2016-2017  Free Software Foundation, Inc.
 
 ;; Author: Lennart Staflin <address@hidden>
 
@@ -27,7 +27,6 @@
 
 (require 'psgml)
 (require 'psgml-parse)
-(require 'psgml-ids)
 (eval-when-compile (require 'cl-lib))
 
 ;; (eval-when-compile
@@ -873,6 +872,23 @@ AVL should be a assoc list mapping symbols to strings."
                                (sgml-element-empty element)
                              (eq t (sgml-element-net-enabled element))))))
 
+(defun psgml-edit--read-ids (prompt curvalue)
+  ;; Ids are separated by spaces.
+  (defvar crm-separator) (defvar crm-local-completion-map)
+  (let ((completion-ignore-case sgml-namecase-general)
+        (crm-separator " ")
+        (crm-local-completion-map
+         (let ((map (make-sparse-keymap)))
+           (set-keymap-parent map crm-local-completion-map)
+           (define-key map " " nil)
+           map)))
+    (mapconcat
+     #'identity
+     (completing-read-multiple prompt psgml-ids-seen nil nil
+                               (and curvalue
+                                    (cons curvalue (length curvalue))))
+     " ")))
+
 (defun sgml-read-attribute-value (attdecl element curvalue)
   "Return the attribute value read from user.
 ATTDECL is the attribute declaration for the attribute to read.
@@ -883,7 +899,8 @@ CURVALUE is nil or a string that will be used as default 
value."
         (tokens (sgml-declared-value-token-group dv))
         (notations (sgml-declared-value-notation dv))
         ; JDF's addition
-        (ids (and (memq dv '(IDREF IDREFS)) (sgml-id-list)))
+        (ids (and (memq dv '(IDREF IDREFS))
+                   (< 0 (hash-table-count psgml-ids-seen))))
         (type (cond (tokens "token")
                     (notations "NOTATION")
                     (t (symbol-name dv))))
@@ -901,33 +918,12 @@ CURVALUE is nil or a string that will be used as default 
value."
                                    (mapcar #'list (or tokens notations))
                                    nil t)))
                (ids
-                (let ((completion-ignore-case sgml-namecase-general)
-                      (minibuffer-local-completion-map sgml-edit-idrefs-map))
-                  (completing-read prompt
-                                   'sgml-idrefs-completer
-                                   nil nil
-                                   (and curvalue
-                                        (cons curvalue (length curvalue))))))
+                 (psgml-edit--read-ids prompt curvalue))
                (t
                 (read-string prompt))))
     (if (and curvalue (equal value ""))
        curvalue value)))
 
-(defun sgml-idrefs-completer (fullstring pred action)
-  (let* ((start (string-match "\\(\\(:?-\\|\\w\\)*\\)$" fullstring))
-        (string (match-string 0 fullstring))
-        (prefix (substring fullstring 0 start)))
-    ;(message "prefix: %s string: %s" prefix string)
-    (cond ((null action)
-          (let ((completion (try-completion string (sgml-id-alist) pred)))
-            (if (eq completion t)
-                t
-              (concat prefix completion))))
-         ((eq action t)
-          (all-completions string (sgml-id-alist) pred))
-         ((eq action 'lambda)
-          (member string (sgml-id-alist))))))
-
 (defun sgml-non-fixed-attributes (attlist)
   (cl-loop for attdecl in attlist
        unless (sgml-default-value-type-p 'FIXED 
diff --git a/psgml-ids.el b/psgml-ids.el
deleted file mode 100644
index f097748..0000000
--- a/psgml-ids.el
+++ /dev/null
@@ -1,95 +0,0 @@
-;;; psgml-ids.el --- Management of ID/IDREFS for PSGML  -*- lexical-binding:t 
-*-
-
-;; Copyright (C) 1999, 2016  Free Software Foundation, Inc.
-
-;; Author: Jean-Daniel Fekete <address@hidden>
-
-;; This program 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
-;; of the License, or (at your option) any later version.
-;; 
-;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Provides some extra functions to manage IDs and IDREFs in attibutes
-
-
-(require 'psgml)
-(require 'psgml-api)
-
-
-(defvar sgml-record-id-p t
-  "Set to non-nil, if you want to record all referenced IDS for completion.")
-
-(defvar sgml-id-list nil
-  "List of IDs available for completing IDREFs")
-;(make-variable-buffer-local 'sgml-id-list)
-
-(defvar sgml-id-alist nil
-  "Alist of IDs available for completing IDREFs")
-
-(defvar sgml-id-list-sorted-p nil
-  "Set to T when the sgml-id-list is sorted")
-
-(defvar sgml-edit-idrefs-map
-  (let ((map (make-sparse-keymap 'sgml-edit-idrefs-map)))
-    (set-keymap-parent map minibuffer-local-completion-map)
-    (define-key map " " 'self-insert-command)
-    map))
-
-
-(defun sgml-id-list ()
-  (unless sgml-id-list-sorted-p
-    (setq sgml-id-list (sort sgml-id-list #'string-lessp)
-         sgml-id-list-sorted-p t
-         sgml-id-alist nil))
-  sgml-id-list)
-
-(defun sgml-id-alist ()
-  (unless sgml-id-alist
-    (setq sgml-id-alist (mapcar #'(lambda (id) (cons id id)) (sgml-id-list))))
-  sgml-id-alist)
-
-(defun sgml-add-id (id)
-  (unless (or (not sgml-record-id-p) (member id sgml-id-list))
-    (push id sgml-id-list)
-    (setq sgml-id-list-sorted-p nil)))
-
-(defun sgml-ids-add-from (element)
-  "Find of all attributes of type ID in ELEMENT and add their value to the
-sgml-id-list."
-  (let ((asl (sgml-element-attribute-specification-list element))
-       (adl (sgml-element-attlist element)))
-
-    (dolist (as asl)
-      (let* ((aname (sgml-attspec-name as))
-            (value (sgml-attspec-attval as))
-            (dcl-value (sgml-attdecl-declared-value
-                        (sgml-lookup-attdecl aname adl))))
-       (if (and (eq dcl-value 'ID)
-                value)
-           (sgml-add-id value))))))
-
-
-(defun sgml-ids-add-current ()
-  (interactive)
-  (sgml-ids-add-from (sgml-find-context-of (point))))
-
-(defun sgml-ids-add-all (&optional element)
-  "Find all the ids of elements inside ELEMENT or the top element if not
-specified"
-  (interactive)
-  (let ((el (or element (sgml-top-element))))
-    (sgml-map-element-modify (function sgml-ids-add-from) el)))
-
-
-(provide 'psgml-ids)
-;;; psgml-ids.el ends here
diff --git a/psgml-maint.el b/psgml-maint.el
index 1775c30..7e27634 100644
--- a/psgml-maint.el
+++ b/psgml-maint.el
@@ -1,6 +1,6 @@
 ;;; psgml-maint.el --- Help functions to maintain PSGML source  -*- 
lexical-binding:t -*-
 
-;; Copyright (C) 1996  Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2017  Free Software Foundation, Inc.
 
 ;; Author: Lennart Staflin <address@hidden>
 ;; Version: $Id: psgml-maint.el,v 1.8 2005/02/09 15:28:58 lenst Exp $
@@ -37,8 +37,7 @@
 
 (defconst psgml-common-files
   '("psgml.el" "psgml-parse.el" "psgml-edit.el" "psgml-dtd.el"
-    "psgml-info.el" "psgml-charent.el" "psgml-api.el"
-    "psgml-ids.el"))
+    "psgml-info.el" "psgml-charent.el" "psgml-api.el"))
 
 (defconst psgml-emacs-files '("psgml-other.el"))
 (defconst psgml-xemacs-files '("psgml-lucid.el"))
diff --git a/psgml-parse.el b/psgml-parse.el
index 156678a..5609767 100644
--- a/psgml-parse.el
+++ b/psgml-parse.el
@@ -1,7 +1,7 @@
 ;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support  -*- 
lexical-binding:t -*-
 ;; $Id: psgml-parse.el,v 2.105 2008/06/21 16:13:51 lenst Exp $
 
-;; Copyright (C) 1994-1998, 2016  Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2016-2017  Free Software Foundation, Inc.
 
 ;; Author: Lennart Staflin <address@hidden>
 ;; Acknowledgment:
@@ -31,8 +31,6 @@
 
 (require 'psgml)
 (require (if (featurep 'xemacs) 'psgml-lucid 'psgml-other))
-(autoload 'sgml-add-id "psgml-ids")
-
 
 ;;; Interface to psgml-dtd
 (eval-and-compile
@@ -3734,6 +3732,9 @@ dtd or `ignore' if the declaration is to be ignored."
 
 ;;;; Parsing attribute values
 
+(defvar psgml-ids-seen (make-hash-table :test #'equal)
+  "Set of `id' attributes that we have encountered.")
+
 (defun sgml-parse-attribute-specification-list (&optional eltype)
   "Parse an attribute specification list.
 Optional argument ELTYPE, is used to resolve omitted name=.
@@ -3774,7 +3775,7 @@ Returns a list of attspec (attribute specification)."
        (attdecl
        ;; JDF's addition 12/2001
        (if (eq (sgml-attdecl-declared-value attdecl) 'ID)
-           (sgml-add-id val))
+           (puthash val t psgml-ids-seen))
        (push (sgml-make-attspec (sgml-attdecl-name attdecl) val)
              asl)
        (when (sgml-default-value-type-p 'CONREF