[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/filesets.el
|
From: |
Richard M. Stallman |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/filesets.el |
|
Date: |
Tue, 07 May 2002 12:11:20 -0400 |
Index: emacs/lisp/filesets.el
diff -c emacs/lisp/filesets.el:1.6 emacs/lisp/filesets.el:1.7
*** emacs/lisp/filesets.el:1.6 Sat May 4 21:55:25 2002
--- emacs/lisp/filesets.el Tue May 7 12:11:20 2002
***************
*** 21,27 ****
;; program's author or from the Free Software Foundation, Inc., 675 Mass
;; Ave, Cambridge, MA 02139, USA.
! (defvar filesets-version "1.8.1")
(defvar filesets-homepage
"http://members.a1.net/t.link/CompEmacsFilesets.html";)
--- 21,27 ----
;; program's author or from the Free Software Foundation, Inc., 675 Mass
;; Ave, Cambridge, MA 02139, USA.
! (defvar filesets-version "1.8.4")
(defvar filesets-homepage
"http://members.a1.net/t.link/CompEmacsFilesets.html";)
***************
*** 151,156 ****
--- 151,188 ----
(when (funcall cond-fn elt)
(setq rv (append rv (list elt)))))))
+ (defun filesets-ormap (fsom-pred lst)
+ "Return the the tail of FSOM-LST for the head of which FSOM-PRED is
non-nil."
+ (let ((fsom-lst lst)
+ (fsom-rv nil))
+ (while (and (not (null fsom-lst))
+ (null fsom-rv))
+ (if (funcall fsom-pred (car fsom-lst))
+ (setq fsom-rv fsom-lst)
+ (setq fsom-lst (cdr fsom-lst))))
+ fsom-rv))
+
+ (defun filesets-some (fss-pred fss-lst)
+ "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
+ Like `some', return the first value of FSS-PRED that is non-nil."
+ (catch 'exit
+ (dolist (fss-this fss-lst nil)
+ (let ((fss-rv (funcall fss-pred fss-this)))
+ (when fss-rv
+ (throw 'exit fss-rv))))))
+ ;(fset 'filesets-some 'some) ;; or use the cl function
+
+ (defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
+ "Find the first occurrence of FSM-ITEM in FSM-LST.
+ It is supposed to work like cl's `member*'. At the moment only the :test
+ key is supported."
+ (let ((fsm-test (or (plist-get fsm-keys ':test)
+ (function equal))))
+ (filesets-ormap (lambda (fsm-this)
+ (funcall fsm-test fsm-item fsm-this))
+ fsm-lst)))
+ ;(fset 'filesets-member 'member*) ;; or use the cl function
+
(defun filesets-sublist (lst beg &optional end)
"Get the sublist of LST from BEG to END - 1."
(let ((rv nil)
***************
*** 611,617 ****
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
! :constraint-flag SYMBOL ... use this viewer only if SYMBOL is non-nil
:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
in conjunction with :capture-output
--- 643,649 ----
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
! :constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
in conjunction with :capture-output
***************
*** 659,665 ****
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
! (symbol :tag "Symbol"))
(list :tag ":ignore-on-open-all"
:value (:ignore-on-open-all t)
(const :format ""
--- 691,697 ----
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
! (sexp :tag "Symbol"))
(list :tag ":ignore-on-open-all"
:value (:ignore-on-open-all t)
(const :format ""
***************
*** 1171,1187 ****
filename)))
(if (file-exists-p f)
f
! (some (lambda (dir)
! (let ((dir (file-name-as-directory dir))
! (files (if (file-exists-p dir)
! (filesets-directory-files dir nil ':files)
! nil)))
! (some (lambda (file)
! (if (equal filename (file-name-nondirectory file))
! (concat dir file)
! nil))
! files)))
! path-list))))
(defun filesets-eviewer-get-props (entry)
--- 1203,1220 ----
filename)))
(if (file-exists-p f)
f
! (filesets-some
! (lambda (dir)
! (let ((dir (file-name-as-directory dir))
! (files (if (file-exists-p dir)
! (filesets-directory-files dir nil ':files)
! nil)))
! (filesets-some (lambda (file)
! (if (equal filename (file-name-nondirectory file))
! (concat dir file)
! nil))
! files)))
! path-list))))
(defun filesets-eviewer-get-props (entry)
***************
*** 1203,1209 ****
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
! (some
(lambda (entry)
(when (and (string-match (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
--- 1236,1242 ----
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
! (filesets-some
(lambda (entry)
(when (and (string-match (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
***************
*** 1213,1219 ****
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
! (some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
--- 1246,1252 ----
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
! (filesets-some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
***************
*** 1414,1423 ****
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
! (some (lambda (x)
! (if (assoc x data)
! x))
! '(:files :tree :pattern :ingroup :file))))
(defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry)
"Get the open-function for FILESET-NAME.
--- 1447,1457 ----
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
! (filesets-some
! (lambda (x)
! (if (assoc x data)
! x))
! '(:files :tree :pattern :ingroup :file))))
(defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry)
"Get the open-function for FILESET-NAME.
***************
*** 1757,1763 ****
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
! (inlist (member* this files :test 'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: '%s' is already in '%s'" this name))
--- 1791,1798 ----
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
! (inlist (filesets-member this files
! :test 'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: '%s' is already in '%s'" this name))
***************
*** 1782,1788 ****
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
! (inlist (member* this files :test 'filesets-files-equalp)))
;;(message "%s %s %s" files this inlist)
(if (and files this inlist)
(let ((new (list (cons ':files (delete (car inlist) files)))))
--- 1817,1824 ----
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
! (inlist (filesets-member this files
! :test 'filesets-files-equalp)))
;;(message "%s %s %s" files this inlist)
(if (and files this inlist)
(let ((new (list (cons ':files (delete (car inlist) files)))))
***************
*** 1946,1956 ****
(and (stringp a)
(stringp b)
(string-match a b))))))
! (some (lambda (x)
! (if (funcall fn (car x) masterfile)
! (nth pos x)
! nil))
! filesets-ingroup-patterns)))
(defun filesets-ingroup-get-pattern (master)
"Access to `filesets-ingroup-patterns'. Extract patterns."
--- 1982,1992 ----
(and (stringp a)
(stringp b)
(string-match a b))))))
! (filesets-some (lambda (x)
! (if (funcall fn (car x) masterfile)
! (nth pos x)
! nil))
! filesets-ingroup-patterns)))
(defun filesets-ingroup-get-pattern (master)
"Access to `filesets-ingroup-patterns'. Extract patterns."
***************
*** 2026,2032 ****
(when (and f
(not (member f flist))
(or (not remdupl-flag)
! (not (member*
f filesets-ingroup-files
:test 'filesets-files-equalp))))
(let ((no-stub-flag
--- 2062,2068 ----
(when (and f
(not (member f flist))
(or (not remdupl-flag)
! (not (filesets-member
f filesets-ingroup-files
:test 'filesets-files-equalp))))
(let ((no-stub-flag