Function: idlwave-xml-create-rinfo-list

idlwave-xml-create-rinfo-list is a byte-compiled function defined in idlwave.el.gz.

Signature

(idlwave-xml-create-rinfo-list XML-ENTRY &optional CLASS EXTRA-KWS)

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/idlwave.el.gz
(defun idlwave-xml-create-rinfo-list (xml-entry &optional class extra-kws)
  ;; Create correctly structured list elements from ROUTINE or METHOD
  ;; XML list structures.  Return a list of list elements, with more
  ;; than one sub-list possible if a routine can serve as both
  ;; procedure and function (e.g. call_method).
  (let* ((nameblock (nth 1 xml-entry))
	 (name (cdr (assq 'name nameblock)))
	 (link (cdr (assq 'link nameblock)))
	 (params (cddr xml-entry))
	 (syntax-vec (make-vector 3 nil)) ; procedure, function, exec command
	 (case-fold-search t)
	 syntax kwd klink pref-list kwds pelem ptype props result type)
    (if class ;; strip out class name from class method name string
	(if (string-match (concat class "::") name)
	    (setq name (substring name (match-end 0)))))
    (while params
      (setq pelem (car params))
      (when (listp pelem)
	(setq ptype (car pelem)
	      props (car (cdr pelem)))
	(cond
	 ((eq ptype 'SYNTAX)
	  (setq syntax (cdr (assq 'name props)))
	  (if (string-match "->" syntax)
	      (setq syntax (replace-match "->" t nil syntax)))
	  (setq type (cdr (assq 'type props)))
	  (push syntax
		(aref syntax-vec (cond
				  ((string-match "^pro" type) 0)
				  ((string-match "^fun" type) 1)
				  ((string-match "^exec" type) 2)))))
	 ((eq ptype 'KEYWORD)
	  (setq kwd (cdr (assq 'name props))
		klink (cdr (assq 'link props)))
	  (if (string-match "^\\[XY\\(Z?\\)\\]" kwd)
	      (progn
		(setq pref-list
		      (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y"))
		      kwd (substring kwd (match-end 0)))
		(cl-loop for x in pref-list do
		      (push (list (concat x kwd) klink) kwds)))
	    (push (list kwd klink) kwds)))

	 (t))); Do nothing for the others
      (setq params (cdr params)))

    ;; Debug
    ;; (if (and (null (aref syntax-vec 0))
    ;;          (null (aref syntax-vec 1))
    ;;          (null (aref syntax-vec 2)))
    ;;   (with-current-buffer (get-buffer-create "IDL_XML_catalog_complaints")
    ;;     (if class
    ;;         (insert (format "Missing SYNTAX entry for %s::%s\n" class name))
    ;;       (insert (message "Missing SYNTAX entry for %s\n" name)))))

    ;; Executive commands are treated specially
    (if (aref syntax-vec 2)
	(cons (substring name 1) link)
      (if extra-kws (setq kwds (nconc kwds extra-kws)))
      (setq kwds (idlwave-rinfo-group-keywords kwds link))
      (cl-loop for idx from 0 to 1 do
	    (if (aref syntax-vec idx)
		(push (append (list name (if (eq idx 0) 'pro 'fun)
				    class '(system)
				    (idlwave-shorten-syntax
				     (aref syntax-vec idx) name class))
			      kwds) result)))
      result)))