Function: idlwave-xml-create-class-method-lists

idlwave-xml-create-class-method-lists is a byte-compiled function defined in idlwave.el.gz.

Signature

(idlwave-xml-create-class-method-lists XML-ENTRY)

Source Code

;; Defined in /usr/src/emacs/lisp/obsolete/idlwave.el.gz
(defun idlwave-xml-create-class-method-lists (xml-entry)
  ;; Create a class list entry from the xml parsed list., returning a
  ;; cons of form (class-entry method-entries).
  (let* ((nameblock (nth 1 xml-entry))
	 (class (cdr (assq 'name nameblock)))
	 (link (cdr (assq 'link nameblock)))
	 (params (cddr xml-entry))
	 (case-fold-search t)
	 class-entry
	 method methods-entry extra-kwds
	 props get-props set-props init-props inherits
	 pelem ptype)
    (while params
      (setq pelem (car params))
      (when (listp pelem)
	(setq ptype (car pelem)
	      props (car (cdr pelem)))
	(cond
	 ((eq ptype 'SUPERCLASS)
	  (let ((pname (cdr (assq 'name props)))
		(plink (cdr (assq 'link props))))
	    (unless (and (string= pname "None")
			 (string= plink "None"))
	      (push pname inherits))))

	 ((eq ptype 'PROPERTY)
	  (let ((pname (cdr (assq 'name props)))
		(plink (cdr (assq 'link props)))
		(get (string= (cdr (assq 'get props)) "Yes"))
		(set (string= (cdr (assq 'set props)) "Yes"))
		(init (string= (cdr (assq 'init props)) "Yes")))
	    (if get (push (list pname plink) get-props))
	    (if set (push (list pname plink) set-props))
	    (if init (push (list pname plink) init-props))))

	 ((eq ptype 'METHOD)
	  (setq method (cdr (assq 'name props)))
	  (setq extra-kwds ;;Assume all property keywords are gathered already
		(cond
		 ((string-match (concat class "::Init") method)
		  (put 'init-props 'matched t)
		  init-props)
		 ((string-match (concat class "::GetProperty") method)
		  (put 'get-props 'matched t)
		  get-props)
		 ((string-match (concat class "::SetProperty") method)
		  (put 'set-props 'matched t)
		  set-props)
		 (t nil)))
	  (setq methods-entry
		(nconc (idlwave-xml-create-rinfo-list pelem class extra-kwds)
		       methods-entry)))
	 (t)))
      (setq params (cdr params)))
    ;;(unless (get 'init-props 'matched)
    ;;  (message "Failed to match Init in class %s" class))
    ;;(unless (get 'get-props 'matched)
    ;;  (message "Failed to match GetProperty in class %s" class))
    ;;(unless (get 'set-props 'matched)
    ;;  (message "Failed to match SetProperty in class %s" class))
    (setq class-entry
	  (if inherits
	      (list class (append '(inherits) inherits) (list 'link link))
	    (list class (list 'link link))))
    (cons class-entry methods-entry)))