/[emacs]/emacs/lisp/filesets.el
ViewVC logotype

Diff of /emacs/lisp/filesets.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by rms, Sun May 5 01:55:25 2002 UTC revision 1.7 by rms, Tue May 7 16:11:20 2002 UTC
# Line 21  Line 21 
21  ;; program's author or from the Free Software Foundation, Inc., 675 Mass  ;; program's author or from the Free Software Foundation, Inc., 675 Mass
22  ;; Ave, Cambridge, MA 02139, USA.  ;; Ave, Cambridge, MA 02139, USA.
23    
24  (defvar filesets-version "1.8.1")  (defvar filesets-version "1.8.4")
25  (defvar filesets-homepage  (defvar filesets-homepage
26    "http://members.a1.net/t.link/CompEmacsFilesets.html")    "http://members.a1.net/t.link/CompEmacsFilesets.html")
27    
# Line 151  COND-FN takes one argument: the current Line 151  COND-FN takes one argument: the current
151        (when (funcall cond-fn elt)        (when (funcall cond-fn elt)
152          (setq rv (append rv (list elt)))))))          (setq rv (append rv (list elt)))))))
153    
154    (defun filesets-ormap (fsom-pred lst)
155      "Return the the tail of FSOM-LST for the head of which FSOM-PRED is non-nil."
156      (let ((fsom-lst lst)
157            (fsom-rv nil))
158        (while (and (not (null fsom-lst))
159                    (null fsom-rv))
160          (if (funcall fsom-pred (car fsom-lst))
161              (setq fsom-rv fsom-lst)
162            (setq fsom-lst (cdr fsom-lst))))
163        fsom-rv))
164    
165    (defun filesets-some (fss-pred fss-lst)
166      "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
167    Like `some', return the first value of FSS-PRED that is non-nil."
168      (catch 'exit
169        (dolist (fss-this fss-lst nil)
170          (let ((fss-rv (funcall fss-pred fss-this)))
171            (when fss-rv
172              (throw 'exit fss-rv))))))
173    ;(fset 'filesets-some 'some) ;; or use the cl function
174    
175    (defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
176      "Find the first occurrence of FSM-ITEM in FSM-LST.
177    It is supposed to work like cl's `member*'. At the moment only the :test
178    key is supported."
179      (let ((fsm-test (or (plist-get fsm-keys ':test)
180                          (function equal))))
181        (filesets-ormap (lambda (fsm-this)
182                          (funcall fsm-test fsm-item fsm-this))
183                        fsm-lst)))
184    ;(fset 'filesets-member 'member*) ;; or use the cl function
185    
186  (defun filesets-sublist (lst beg &optional end)  (defun filesets-sublist (lst beg &optional end)
187    "Get the sublist of LST from BEG to END - 1."    "Get the sublist of LST from BEG to END - 1."
188    (let ((rv  nil)    (let ((rv  nil)
# Line 611  i.e. on open-all-files-events or when ru Line 643  i.e. on open-all-files-events or when ru
643    
644  :constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil  :constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
645    
646  :constraint-flag SYMBOL ... use this viewer only if SYMBOL is non-nil  :constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
647    
648  :open-hook HOOK ... run hooks after spawning the viewer -- mainly useful  :open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
649  in conjunction with :capture-output  in conjunction with :capture-output
# Line 659  In order to view pdf or rtf files in an Line 691  In order to view pdf or rtf files in an
691                                        :value (:constraint-flag)                                        :value (:constraint-flag)
692                                        (const :format ""                                        (const :format ""
693                                               :value :constraint-flag)                                               :value :constraint-flag)
694                                        (symbol :tag "Symbol"))                                        (sexp :tag "Symbol"))
695                                  (list :tag ":ignore-on-open-all"                                  (list :tag ":ignore-on-open-all"
696                                        :value (:ignore-on-open-all t)                                        :value (:ignore-on-open-all t)
697                                        (const  :format ""                                        (const  :format ""
# Line 1171  non-nil." Line 1203  non-nil."
1203                     filename)))                     filename)))
1204      (if (file-exists-p f)      (if (file-exists-p f)
1205          f          f
1206        (some (lambda (dir)        (filesets-some
1207                (let ((dir (file-name-as-directory dir))         (lambda (dir)
1208                      (files (if (file-exists-p dir)           (let ((dir (file-name-as-directory dir))
1209                                 (filesets-directory-files dir nil ':files)                 (files (if (file-exists-p dir)
1210                               nil)))                            (filesets-directory-files dir nil ':files)
1211                  (some (lambda (file)                          nil)))
1212                          (if (equal filename (file-name-nondirectory file))             (filesets-some (lambda (file)
1213                              (concat dir file)                              (if (equal filename (file-name-nondirectory file))
1214                            nil))                                  (concat dir file)
1215                        files)))                                nil))
1216              path-list))))                            files)))
1217           path-list))))
1218    
1219    
1220  (defun filesets-eviewer-get-props (entry)  (defun filesets-eviewer-get-props (entry)
# Line 1203  non-nil." Line 1236  non-nil."
1236  (defun filesets-get-external-viewer (file)  (defun filesets-get-external-viewer (file)
1237    "Find an external viewer for FILE."    "Find an external viewer for FILE."
1238    (let ((filename (file-name-nondirectory file)))    (let ((filename (file-name-nondirectory file)))
1239      (some      (filesets-some
1240       (lambda (entry)       (lambda (entry)
1241         (when (and (string-match (nth 0 entry) filename)         (when (and (string-match (nth 0 entry) filename)
1242                    (filesets-eviewer-constraint-p entry))                    (filesets-eviewer-constraint-p entry))
# Line 1213  non-nil." Line 1246  non-nil."
1246  (defun filesets-get-external-viewer-by-name (name)  (defun filesets-get-external-viewer-by-name (name)
1247    "Get the external viewer definition called NAME."    "Get the external viewer definition called NAME."
1248    (when name    (when name
1249      (some      (filesets-some
1250       (lambda (entry)       (lambda (entry)
1251         (when (and (string-equal (nth 1 entry) name)         (when (and (string-equal (nth 1 entry) name)
1252                    (filesets-eviewer-constraint-p entry))                    (filesets-eviewer-constraint-p entry))
# Line 1414  Return DEFAULT if not found.  Return (ca Line 1447  Return DEFAULT if not found.  Return (ca
1447    "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.    "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
1448  See `filesets-data'."  See `filesets-data'."
1449    (let ((data (filesets-data-get-data entry)))    (let ((data (filesets-data-get-data entry)))
1450      (some (lambda (x)      (filesets-some
1451              (if (assoc x data)       (lambda (x)
1452                  x))         (if (assoc x data)
1453            '(:files :tree :pattern :ingroup :file))))             x))
1454         '(:files :tree :pattern :ingroup :file))))
1455    
1456  (defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry)  (defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry)
1457    "Get the open-function for FILESET-NAME.    "Get the open-function for FILESET-NAME.
# Line 1757  User will be queried, if no fileset name Line 1791  User will be queried, if no fileset name
1791      (if entry      (if entry
1792          (let* ((files  (filesets-entry-get-files entry))          (let* ((files  (filesets-entry-get-files entry))
1793                 (this   (buffer-file-name buffer))                 (this   (buffer-file-name buffer))
1794                 (inlist (member* this files :test 'filesets-files-equalp)))                 (inlist (filesets-member this files
1795                                            :test 'filesets-files-equalp)))
1796            (cond            (cond
1797             (inlist             (inlist
1798              (message "Filesets: '%s' is already in '%s'" this name))              (message "Filesets: '%s' is already in '%s'" this name))
# Line 1782  User will be queried, if no fileset name Line 1817  User will be queried, if no fileset name
1817      (if entry      (if entry
1818          (let* ((files  (filesets-entry-get-files entry))          (let* ((files  (filesets-entry-get-files entry))
1819                 (this   (buffer-file-name buffer))                 (this   (buffer-file-name buffer))
1820                 (inlist (member* this files :test 'filesets-files-equalp)))                 (inlist (filesets-member this files
1821                                            :test 'filesets-files-equalp)))
1822            ;;(message "%s %s %s" files this inlist)            ;;(message "%s %s %s" files this inlist)
1823            (if (and files this inlist)            (if (and files this inlist)
1824                (let ((new (list (cons ':files (delete (car inlist) files)))))                (let ((new (list (cons ':files (delete (car inlist) files)))))
# Line 1946  LOOKUP-NAME is used as lookup name for r Line 1982  LOOKUP-NAME is used as lookup name for r
1982                        (and (stringp a)                        (and (stringp a)
1983                             (stringp b)                             (stringp b)
1984                             (string-match a b))))))                             (string-match a b))))))
1985      (some (lambda (x)      (filesets-some (lambda (x)
1986              (if (funcall fn (car x) masterfile)                       (if (funcall fn (car x) masterfile)
1987                  (nth pos x)                           (nth pos x)
1988                nil))                         nil))
1989            filesets-ingroup-patterns)))                     filesets-ingroup-patterns)))
1990    
1991  (defun filesets-ingroup-get-pattern (master)  (defun filesets-ingroup-get-pattern (master)
1992    "Access to `filesets-ingroup-patterns'.  Extract patterns."    "Access to `filesets-ingroup-patterns'.  Extract patterns."
# Line 2026  LOOKUP-NAME is used as lookup name for r Line 2062  LOOKUP-NAME is used as lookup name for r
2062                        (when (and f                        (when (and f
2063                                   (not (member f flist))                                   (not (member f flist))
2064                                   (or (not remdupl-flag)                                   (or (not remdupl-flag)
2065                                       (not (member*                                       (not (filesets-member
2066                                             f filesets-ingroup-files                                             f filesets-ingroup-files
2067                                             :test 'filesets-files-equalp))))                                             :test 'filesets-files-equalp))))
2068                          (let ((no-stub-flag                          (let ((no-stub-flag

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26