Mercurial > emacs

comparison lisp/filesets.el @ 49475:796b9b8e53c3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(filesets-file-open): Fix typo.
author Juanma Barranquero <lekktu@gmail.com>
date Mon, 27 Jan 2003 08:44:27 +0000
parents 43b27399e724
children 11093cda819e d7ddb3e565de
comparison
equal deleted inserted replaced
49474:a53b597e29e0 49475:796b9b8e53c3
161 (setq fsom-rv fsom-lst) 161 (setq fsom-rv fsom-lst)
162 (setq fsom-lst (cdr fsom-lst)))) 162 (setq fsom-lst (cdr fsom-lst))))
163 fsom-rv)) 163 fsom-rv))
164 164
165 (defun filesets-some (fss-pred fss-lst) 165 (defun filesets-some (fss-pred fss-lst)
166 "Return non-nil if FSS-PRED is non-nil for any element of 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." 167 Like `some', return the first value of FSS-PRED that is non-nil."
168 (catch 'exit 168 (catch 'exit
169 (dolist (fss-this fss-lst nil) 169 (dolist (fss-this fss-lst nil)
170 (let ((fss-rv (funcall fss-pred fss-this))) 170 (let ((fss-rv (funcall fss-pred fss-this)))
171 (when fss-rv 171 (when fss-rv
177 It is supposed to work like cl's `member*'. At the moment only the :test 177 It is supposed to work like cl's `member*'. At the moment only the :test
178 key is supported." 178 key is supported."
179 (let ((fsm-test (or (plist-get fsm-keys ':test) 179 (let ((fsm-test (or (plist-get fsm-keys ':test)
180 (function equal)))) 180 (function equal))))
181 (filesets-ormap (lambda (fsm-this) 181 (filesets-ormap (lambda (fsm-this)
182 (funcall fsm-test fsm-item fsm-this)) 182 (funcall fsm-test fsm-item fsm-this))
183 fsm-lst))) 183 fsm-lst)))
184 ;(fset 'filesets-member 'member*) ;; or use the cl function 184 ;(fset 'filesets-member 'member*) ;; or use the cl function
185 185
186 (defun filesets-sublist (lst beg &optional end) 186 (defun filesets-sublist (lst beg &optional end)
187 "Get the sublist of LST from BEG to END - 1." 187 "Get the sublist of LST from BEG to END - 1."
197 (defun filesets-select-command (cmd-list) 197 (defun filesets-select-command (cmd-list)
198 "Select one command from CMD-LIST -- a string with space separated names." 198 "Select one command from CMD-LIST -- a string with space separated names."
199 (let ((this (shell-command-to-string 199 (let ((this (shell-command-to-string
200 (format "which --skip-alias %s 2> /dev/null | head -n 1" 200 (format "which --skip-alias %s 2> /dev/null | head -n 1"
201 cmd-list)))) 201 cmd-list))))
202 (if (equal this "") 202 (if (equal this "")
203 nil 203 nil
204 (file-name-nondirectory (substring this 0 (- (length this) 1)))))) 204 (file-name-nondirectory (substring this 0 (- (length this) 1))))))
205 205
206 (defun filesets-which-command (cmd) 206 (defun filesets-which-command (cmd)
207 "Calls \"which CMD\"." 207 "Calls \"which CMD\"."
351 (put 'filesets-menu-cache-file 'risky-local-variable t) 351 (put 'filesets-menu-cache-file 'risky-local-variable t)
352 352
353 (defcustom filesets-menu-cache-contents 353 (defcustom filesets-menu-cache-contents
354 '(filesets-be-docile-flag 354 '(filesets-be-docile-flag
355 filesets-submenus 355 filesets-submenus
356 filesets-menu-cache 356 filesets-menu-cache
357 filesets-ingroup-cache) 357 filesets-ingroup-cache)
358 "*Stuff we want to save in `filesets-menu-cache-file'. 358 "*Stuff we want to save in `filesets-menu-cache-file'.
359 359
360 Possible uses: don't save configuration data in the main startup files 360 Possible uses: don't save configuration data in the main startup files
361 but in filesets's own cache. In this case add `filesets-data' to this 361 but in filesets's own cache. In this case add `filesets-data' to this
743 (:match-number 2) 743 (:match-number 2)
744 (:stub-flag t) 744 (:stub-flag t)
745 (:get-file-name (lambda (master file) 745 (:get-file-name (lambda (master file)
746 (filesets-which-file master 746 (filesets-which-file master
747 (concat file ".sty") 747 (concat file ".sty")
748 (filesets-convert-path-list 748 (filesets-convert-path-list
749 (or (getenv "MY_TEXINPUTS") 749 (or (getenv "MY_TEXINPUTS")
750 (getenv "TEXINPUTS"))))))) 750 (getenv "TEXINPUTS")))))))
751 ((:name "Include") 751 ((:name "Include")
752 (:pattern "\\\\include\\W*{\\W*\\(.+\\)\\W*}") 752 (:pattern "\\\\include\\W*{\\W*\\(.+\\)\\W*}")
753 (:get-file-name (lambda (master file) 753 (:get-file-name (lambda (master file)
754 (filesets-which-file master 754 (filesets-which-file master
755 (concat file ".tex") 755 (concat file ".tex")
756 (filesets-convert-path-list 756 (filesets-convert-path-list
757 (or (getenv "MY_TEXINPUTS") 757 (or (getenv "MY_TEXINPUTS")
758 (getenv "TEXINPUTS")))))) 758 (getenv "TEXINPUTS"))))))
759 (:scan-depth 5)) 759 (:scan-depth 5))
760 ((:name "Input") 760 ((:name "Input")
761 (:pattern "\\\\input\\W*{\\W*\\(.+\\)\\W*}") 761 (:pattern "\\\\input\\W*{\\W*\\(.+\\)\\W*}")
762 (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b)))) 762 (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
763 (:get-file-name (lambda (master file) 763 (:get-file-name (lambda (master file)
764 (filesets-which-file master 764 (filesets-which-file master
765 (concat file ".tex") 765 (concat file ".tex")
766 (filesets-convert-path-list 766 (filesets-convert-path-list
767 (or (getenv "MY_TEXINPUTS") 767 (or (getenv "MY_TEXINPUTS")
768 (getenv "TEXINPUTS")))))) 768 (getenv "TEXINPUTS"))))))
769 (:scan-depth 5)) 769 (:scan-depth 5))
770 ((:name "Bibliography") 770 ((:name "Bibliography")
771 (:pattern "\\\\bibliography\\W*{\\W*\\(.+\\)\\W*}") 771 (:pattern "\\\\bibliography\\W*{\\W*\\(.+\\)\\W*}")
772 (:get-file-name (lambda (master file) 772 (:get-file-name (lambda (master file)
773 (filesets-which-file master 773 (filesets-which-file master
774 (concat file ".bib") 774 (concat file ".bib")
775 (filesets-convert-path-list 775 (filesets-convert-path-list
776 (or (getenv "MY_BIBINPUTS") 776 (or (getenv "MY_BIBINPUTS")
777 (getenv "BIBINPUTS"))))))))) 777 (getenv "BIBINPUTS")))))))))
778 ("^.+\\.el$" t 778 ("^.+\\.el$" t
779 (((:name "Require") 779 (((:name "Require")
780 (:pattern "(require\\W+'\\(.+\\))") 780 (:pattern "(require\\W+'\\(.+\\))")
1064 (progn 1064 (progn
1065 (fset 'filesets-error 'error) 1065 (fset 'filesets-error 'error)
1066 (fset 'filesets-add-submenu 'add-submenu)) 1066 (fset 'filesets-add-submenu 'add-submenu))
1067 1067
1068 (require 'easymenu) 1068 (require 'easymenu)
1069 1069
1070 (defun filesets-error (class &rest args) 1070 (defun filesets-error (class &rest args)
1071 "`error' wrapper." 1071 "`error' wrapper."
1072 (error (mapconcat 'identity args " "))) 1072 (error (mapconcat 'identity args " ")))
1073 1073
1074 ;; This should work for 21.1 Emacs 1074 ;; This should work for 21.1 Emacs
1120 (cond 1120 (cond
1121 ((file-exists-p dir) 1121 ((file-exists-p dir)
1122 (let ((files nil) 1122 (let ((files nil)
1123 (dirs nil)) 1123 (dirs nil))
1124 (dolist (this (file-name-all-completions "" dir)) 1124 (dolist (this (file-name-all-completions "" dir))
1125 (cond 1125 (cond
1126 ((string-match "^\\.+/$" this) 1126 ((string-match "^\\.+/$" this)
1127 nil) 1127 nil)
1128 ((string-match "[:/\\]$" this) 1128 ((string-match "[:/\\]$" this)
1129 (when (or (not match-dirs-flag) 1129 (when (or (not match-dirs-flag)
1130 (not pattern) 1130 (not pattern)
1131 (string-match pattern this)) 1131 (string-match pattern this))
1132 (filesets-message 5 "Filesets: matched dir %S with pattern %S" 1132 (filesets-message 5 "Filesets: matched dir %S with pattern %S"
1133 this pattern) 1133 this pattern)
1134 (setq dirs (cons this dirs)))) 1134 (setq dirs (cons this dirs))))
1135 (t 1135 (t
1136 (when (or (not pattern) 1136 (when (or (not pattern)
1137 (string-match pattern this)) 1137 (string-match pattern this))
1138 (filesets-message 5 "Filesets: matched file %S with pattern %S" 1138 (filesets-message 5 "Filesets: matched file %S with pattern %S"
1139 this pattern) 1139 this pattern)
1140 (setq files (cons (if full-flag 1140 (setq files (cons (if full-flag
1141 (concat (file-name-as-directory dir) this) 1141 (concat (file-name-as-directory dir) this)
1142 this) 1142 this)
1143 files)))))) 1143 files))))))
1291 (let ((def (filesets-eviewer-get-props 1291 (let ((def (filesets-eviewer-get-props
1292 (or entry 1292 (or entry
1293 (filesets-get-external-viewer filename))))) 1293 (filesets-get-external-viewer filename)))))
1294 (when def 1294 (when def
1295 (filesets-alist-get def property nil t)))) 1295 (filesets-alist-get def property nil t))))
1296 1296
1297 (defun filesets-reset-filename-on-change () 1297 (defun filesets-reset-filename-on-change ()
1298 "Reset a buffer's filename if the buffer is being modified." 1298 "Reset a buffer's filename if the buffer is being modified."
1299 (when filesets-output-buffer-flag 1299 (when filesets-output-buffer-flag
1300 (set-visited-file-name nil t))) 1300 (set-visited-file-name nil t)))
1301 1301
1528 (defun filesets-entry-get-master (entry) 1528 (defun filesets-entry-get-master (entry)
1529 "Get the base file for fileset ENTRY." 1529 "Get the base file for fileset ENTRY."
1530 (filesets-data-get entry ':ingroup nil t)) 1530 (filesets-data-get entry ':ingroup nil t))
1531 1531
1532 (defun filesets-file-open (open-function file-name &optional fileset-name) 1532 (defun filesets-file-open (open-function file-name &optional fileset-name)
1533 "Open FILE-NAME using OPEN-FUNCTION. If OPEN-FUNCTION is nil, it's 1533 "Open FILE-NAME using OPEN-FUNCTION. If OPEN-FUNCTION is nil, its
1534 value will be deduced from FILESET-NAME" 1534 value will be deduced from FILESET-NAME."
1535 (let ((open-function (or open-function 1535 (let ((open-function (or open-function
1536 (filesets-entry-get-open-fn fileset-name)))) 1536 (filesets-entry-get-open-fn fileset-name))))
1537 (if (file-readable-p file-name) 1537 (if (file-readable-p file-name)
1538 (funcall open-function file-name) 1538 (funcall open-function file-name)
1539 (message "Filesets: Couldn't open `%s'" file-name)))) 1539 (message "Filesets: Couldn't open `%s'" file-name))))
1571 (rv nil)) 1571 (rv nil))
1572 (dolist (this args rv) 1572 (dolist (this args rv)
1573 (cond 1573 (cond
1574 ((and (symbolp this) (fboundp this)) 1574 ((and (symbolp this) (fboundp this))
1575 (let ((x (funcall this))) 1575 (let ((x (funcall this)))
1576 (setq rv (append rv (if (listp x) x (list x)))))) 1576 (setq rv (append rv (if (listp x) x (list x))))))
1577 (t 1577 (t
1578 (setq rv (append rv (list this)))))))) 1578 (setq rv (append rv (list this))))))))
1579 1579
1580 (defun filesets-cmd-get-fn (cmd-name) 1580 (defun filesets-cmd-get-fn (cmd-name)
1581 (let ((def (filesets-cmd-get-def cmd-name))) 1581 (let ((def (filesets-cmd-get-def cmd-name)))
1616 'on-cmd)) 1616 'on-cmd))
1617 (files (if (and fileset 1617 (files (if (and fileset
1618 (or (equal mode ':ingroup) 1618 (or (equal mode ':ingroup)
1619 (equal mode ':tree))) 1619 (equal mode ':tree)))
1620 (filesets-get-filelist fileset mode event) 1620 (filesets-get-filelist fileset mode event)
1621 (filesets-get-filelist 1621 (filesets-get-filelist
1622 (filesets-get-fileset-from-name name) 1622 (filesets-get-fileset-from-name name)
1623 mode event)))) 1623 mode event))))
1624 (when files 1624 (when files
1625 (let ((fn (filesets-cmd-get-fn cmd-name)) 1625 (let ((fn (filesets-cmd-get-fn cmd-name))
1626 (args (filesets-cmd-get-args cmd-name))) 1626 (args (filesets-cmd-get-args cmd-name)))
1642 this 1642 this
1643 (lambda (this) 1643 (lambda (this)
1644 (if (equal txt "") "" " ") 1644 (if (equal txt "") "" " ")
1645 (format "%s" this)))))))) 1645 (format "%s" this))))))))
1646 (cmd (concat fn " " args))) 1646 (cmd (concat fn " " args)))
1647 (filesets-cmd-show-result 1647 (filesets-cmd-show-result
1648 cmd (shell-command-to-string cmd)))) 1648 cmd (shell-command-to-string cmd))))
1649 ((symbolp fn) 1649 ((symbolp fn)
1650 (let ((args 1650 (let ((args
1651 (let ((argl nil)) 1651 (let ((argl nil))
1652 (dolist (this args argl) 1652 (dolist (this args argl)
1798 (inlist (filesets-member this files 1798 (inlist (filesets-member this files
1799 :test 'filesets-files-equalp))) 1799 :test 'filesets-files-equalp)))
1800 (cond 1800 (cond
1801 (inlist 1801 (inlist
1802 (message "Filesets: '%s' is already in '%s'" this name)) 1802 (message "Filesets: '%s' is already in '%s'" this name))
1803 ((and (equal (filesets-entry-mode entry) ':files) 1803 ((and (equal (filesets-entry-mode entry) ':files)
1804 this) 1804 this)
1805 (filesets-entry-set-files entry (cons this files) t) 1805 (filesets-entry-set-files entry (cons this files) t)
1806 (filesets-set-config name 'filesets-data filesets-data)) 1806 (filesets-set-config name 'filesets-data filesets-data))
1807 (t 1807 (t
1808 (message "Filesets: Can't add '%s' to fileset '%s'" this name))))))) 1808 (message "Filesets: Can't add '%s' to fileset '%s'" this name)))))))
1909 ((null x)) 1909 ((null x))
1910 (let ((y (concat (elt (car x) 0) 1910 (let ((y (concat (elt (car x) 0)
1911 (if (null (cdr x)) 1911 (if (null (cdr x))
1912 "" 1912 ""
1913 ", ")))) 1913 ", "))))
1914 (setq rv 1914 (setq rv
1915 (concat 1915 (concat
1916 rv 1916 rv
1917 (if filesets-menu-shortcuts-flag 1917 (if filesets-menu-shortcuts-flag
1918 (substring y 2) 1918 (substring y 2)
1919 y))))) 1919 y)))))
2115 (file-name-nondirectory master)))) 2115 (file-name-nondirectory master))))
2116 (setq rv 2116 (setq rv
2117 (append rv 2117 (append rv
2118 (if files 2118 (if files
2119 `((,nm 2119 `((,nm
2120 [,(concat "Inclusion Group: " 2120 [,(concat "Inclusion Group: "
2121 (file-name-nondirectory master)) 2121 (file-name-nondirectory master))
2122 (filesets-open ':ingroup ',master ',fsn)] 2122 (filesets-open ':ingroup ',master ',fsn)]
2123 "---" 2123 "---"
2124 [,master (filesets-file-open nil ',master ',fsn)] 2124 [,master (filesets-file-open nil ',master ',fsn)]
2125 "---" 2125 "---"
2126 ,@(let ((count 0)) 2126 ,@(let ((count 0))
2127 (mapcar 2127 (mapcar
2128 (lambda (this) 2128 (lambda (this)
2129 (setq count (+ count 1)) 2129 (setq count (+ count 1))
2130 (let ((ff (filesets-ingroup-collect-build-menu 2130 (let ((ff (filesets-ingroup-collect-build-menu
2131 fs (list this) count))) 2131 fs (list this) count)))
2132 (if (= (length ff) 1) 2132 (if (= (length ff) 1)
2133 (car ff) 2133 (car ff)
2134 ff))) 2134 ff)))
2135 files)) 2135 files))
2182 (lambda (x) 2182 (lambda (x)
2183 (setq count (+ count 1)) 2183 (setq count (+ count 1))
2184 (let* ((x (file-name-as-directory x)) 2184 (let* ((x (file-name-as-directory x))
2185 (xx (concat dir x)) 2185 (xx (concat dir x))
2186 (dd (filesets-build-dir-submenu-now 2186 (dd (filesets-build-dir-submenu-now
2187 (+ level 1) depth entry 2187 (+ level 1) depth entry
2188 lookup-name xx patt fd)) 2188 lookup-name xx patt fd))
2189 (nm (concat (filesets-get-shortcut count) 2189 (nm (concat (filesets-get-shortcut count)
2190 x))) 2190 x)))
2191 (if dd 2191 (if dd
2192 `(,nm ,@dd) 2192 `(,nm ,@dd)
2204 (append header 2204 (append header
2205 (filesets-wrap-submenu 2205 (filesets-wrap-submenu
2206 (append 2206 (append
2207 dirsmenu 2207 dirsmenu
2208 filesmenu)) 2208 filesmenu))
2209 (filesets-get-menu-epilog `(,dir ,patt) ':tree 2209 (filesets-get-menu-epilog `(,dir ,patt) ':tree
2210 lookup-name rebuild-flag))) 2210 lookup-name rebuild-flag)))
2211 nil)) 2211 nil))
2212 2212
2213 (defun filesets-build-dir-submenu (entry lookup-name dir patt) 2213 (defun filesets-build-dir-submenu (entry lookup-name dir patt)
2214 "Build a :tree submenu named LOOKUP-NAME with base directory DIR including 2214 "Build a :tree submenu named LOOKUP-NAME with base directory DIR including
2380 (delete-file filesets-menu-cache-file)) 2380 (delete-file filesets-menu-cache-file))
2381 ;;(message "Filesets: saving menu cache") 2381 ;;(message "Filesets: saving menu cache")
2382 (with-temp-buffer 2382 (with-temp-buffer
2383 (dolist (this filesets-menu-cache-contents) 2383 (dolist (this filesets-menu-cache-contents)
2384 (if (get this 'custom-type) 2384 (if (get this 'custom-type)
2385 (progn 2385 (progn
2386 (insert (format "(setq-default %s '%S)" this (eval this))) 2386 (insert (format "(setq-default %s '%S)" this (eval this)))
2387 (when filesets-menu-ensure-use-cached 2387 (when filesets-menu-ensure-use-cached
2388 (newline) 2388 (newline)
2389 (insert (format "(setq %s (cons '%s %s))" 2389 (insert (format "(setq %s (cons '%s %s))"
2390 'filesets-ignore-next-set-default 2390 'filesets-ignore-next-set-default