Function: filesets-ingroup-collect-files

filesets-ingroup-collect-files is a byte-compiled function defined in filesets.el.gz.

Signature

(filesets-ingroup-collect-files FS &optional REMDUPL-FLAG MASTER DEPTH)

Documentation

Helper function for filesets-ingroup-collect. Collect file names.

Source Code

;; Defined in /usr/src/emacs/lisp/filesets.el.gz
(defun filesets-ingroup-collect-files (fs &optional remdupl-flag master depth)
  "Helper function for `filesets-ingroup-collect'.  Collect file names."
  (let* ((master       (or master
			   (filesets-entry-get-master fs)))
	 (remdupl-flag (or remdupl-flag
			   (filesets-ingroup-get-remdupl-p master))))
    (filesets-ingroup-cache-put master nil)
    (filesets-message 2 "Filesets: parsing %S" master)
    (let ((cmdpatts (filesets-ingroup-get-pattern master))
	  (count    0)
	  (rv       nil))
      (if cmdpatts
	  (dolist (this-def cmdpatts rv)
	    (let* ((this-patt (filesets-alist-get this-def ':pattern nil t))
		   (this-name (filesets-alist-get this-def ':name "" t))
		   (this-pp   (filesets-alist-get this-def ':preprocess nil t))
		   (this-mn   (filesets-alist-get this-def ':match-number 1 t))
		   (this-sd   (or depth
				  (filesets-alist-get this-def ':scan-depth 0 t)))
		   (this-csp  (filesets-alist-get this-def ':case-sensitive nil t))
		   (this-fn   (filesets-alist-get
			       this-def ':get-file-name 'filesets-which-file t))
		   (this-stubp (filesets-alist-get this-def ':stubp nil t))
		   (this-stub-flag (filesets-alist-get this-def ':stub-flag nil t))
		   (flist     nil)
		   (lst      nil))
	      (cond
	       ((not this-patt)
                (error "Filesets: malformed :ingroup definition %s" this-def))
	       ((< this-sd 0)
		nil)
	       (t
		(with-temp-buffer
		  (insert-file-contents master)
		  (goto-char (point-min))
		  (when this-pp
		    (funcall this-pp))
		  (while (filesets-ingroup-collect-finder this-patt this-csp)
		    (let* ((txt (match-string this-mn))
			   (f   (funcall this-fn master txt)))
		      (when (and f
				 (not (member f flist))
				 (or (not remdupl-flag)
				     (not (cl-member
					   f filesets-ingroup-files
					   :test #'filesets-files-equalp))))
			(let ((no-stub-flag
			       (and (not this-stub-flag)
				    (if this-stubp
					(not (funcall this-stubp master f))
				      t))))
			  (setq count (+ count 1))
			  (setq flist (cons f flist))
			  (setq filesets-ingroup-files
				(cons f filesets-ingroup-files))
			  (when no-stub-flag
			    (filesets-ingroup-cache-put master f))
			  (push f lst))))))
		(when lst
		  (setq rv
			;; FIXME: O(n²) performance bug because of repeated
			;; `nconc'.
			(nconc rv
			       (mapcar (lambda (this)
					 `((,this ,this-name)
					   ,@(filesets-ingroup-collect-files
					      fs remdupl-flag this
					      (- this-sd 1))))
				       (nreverse lst)))))))))
	(filesets-message 2 "Filesets: no patterns defined for %S" master)))))