-;;; filesets.el --- handle group of files
+;;; filesets.el --- handle group of files -*- coding: utf-8 -*-
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
;; Author: Thomas Link <sanobast-emacs@yahoo.de>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: filesets convenience
;; This file is part of GNU Emacs.
;; inclusion group (i.e. a base file including other files).
;; Usage:
-;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file.
+;; 1. Put (require 'filesets) and (filesets-init) in your init file.
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
;;; Some variables
(defun filesets-filter-list (lst cond-fn)
"Remove all elements not conforming to COND-FN from list LST.
COND-FN takes one argument: the current element."
-; (remove* 'dummy lst :test (lambda (dummy elt)
+; (cl-remove 'dummy lst :test (lambda (dummy elt)
; (not (funcall cond-fn elt)))))
(let ((rv nil))
(dolist (elt lst rv)
(let ((fss-rv (funcall fss-pred fss-this)))
(when fss-rv
(throw 'exit fss-rv))))))
-;(fset 'filesets-some 'some) ;; or use the cl function
+;(fset 'filesets-some 'cl-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.
(filesets-ormap (lambda (fsm-this)
(funcall fsm-test fsm-item fsm-this))
fsm-lst)))
-;(fset 'filesets-member 'member*) ;; or use the cl function
+;(fset 'filesets-member 'cl-member) ;; or use the cl function
(defun filesets-sublist (lst beg &optional end)
"Get the sublist of LST from BEG to END - 1."
(defun filesets-which-command-p (cmd)
"Call \"which CMD\" and return non-nil if the command was found."
- (when (string-match (format "\\(/[^/]+\\)?/%s" cmd)
- (filesets-which-command cmd))
+ (when (string-match-p (format "\\(/[^/]+\\)?/%s" cmd)
+ (filesets-which-command cmd))
cmd))
(defun filesets-message (level &rest args)
(not ignore-flag)))
(defun filesets-set-default! (sym val)
- "Call `filestes-set-default' and reset cached data (i.e. rebuild menu)."
+ "Call `filesets-set-default' and reset cached data (i.e. rebuild menu)."
(when (filesets-set-default sym val)
(filesets-reset-fileset)))
(defun filesets-set-default+ (sym val)
- "Call `filestes-set-default' and reset filesets' standard menu."
+ "Call `filesets-set-default' and reset filesets' standard menu."
(when (filesets-set-default sym val)
(setq filesets-has-changed-flag t)))
; (filesets-reset-fileset nil t)))
(sexp :tag "Other" :value nil)))
:group 'filesets)
-(defcustom filesets-cache-fill-content-hooks nil
- "Hooks to run when writing the contents of filesets' cache file.
+(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
+ 'filesets-cache-fill-content-hook "24.3")
+(defcustom filesets-cache-fill-content-hook nil
+ "Hook run when writing the contents of filesets' cache file.
The hook is called with the cache file as current buffer and the cursor
at the last position. I.e. each hook has to make sure that the cursor is
:group 'filesets)
(defcustom filesets-max-entry-length 50
- "Truncate names of splitted submenus to this length."
+ "Truncate names of split submenus to this length."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
-Set this to 0, if you don't use XEmacs' buffer tabs."
+Set this to 0, if you don't use XEmacs's buffer tabs."
:set (function filesets-set-default)
:type 'number
:group 'filesets)
(:match-number 2)
(:get-file-name (lambda (master file)
(filesets-which-file master file load-path))))))
- ("^\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)$" t
- (((:pattern "\\<\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)\\>")
+ ("^\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)$" t
+ (((:pattern "\\<\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)\\>")
(:scan-depth 5)
(:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
(:case-sensitive t)
(require 'easymenu)
- (defun filesets-error (class &rest args)
+ (defun filesets-error (_class &rest args)
"`error' wrapper."
(error "%s" (mapconcat 'identity args " ")))
If NEGATIVE is non-nil, remove all directory names."
(filesets-filter-list lst
(lambda (x)
- (and (not (string-match "^\\.+/$" x))
+ (and (not (string-match-p "^\\.+/$" x))
(if negative
- (not (string-match "[:/\\]$" x))
- (string-match "[:/\\]$" x))))))
+ (not (string-match-p "[:/\\]$" x))
+ (string-match-p "[:/\\]$" x))))))
(defun filesets-conditional-sort (lst &optional access-fn)
"Return a sorted copy of LST, LST being a list of strings.
(dirs nil))
(dolist (this (file-name-all-completions "" dir))
(cond
- ((string-match "^\\.+/$" this)
+ ((string-match-p "^\\.+/$" this)
nil)
- ((string-match "[:/\\]$" this)
+ ((string-match-p "[:/\\]$" this)
(when (or (not match-dirs-flag)
(not pattern)
- (string-match pattern this))
+ (string-match-p pattern this))
(filesets-message 5 "Filesets: matched dir %S with pattern %S"
this pattern)
(setq dirs (cons this dirs))))
(t
(when (or (not pattern)
- (string-match pattern this))
+ (string-match-p pattern this))
(filesets-message 5 "Filesets: matched file %S with pattern %S"
this pattern)
(setq files (cons (if full-flag
(let ((filename (file-name-nondirectory file)))
(filesets-some
(lambda (entry)
- (when (and (string-match (nth 0 entry) filename)
+ (when (and (string-match-p (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
entry))
filesets-external-viewers)))
(or entry
(filesets-get-external-viewer filename)))))
(filesets-alist-get def
- (case event
- ((on-open-all) ':ignore-on-open-all)
- ((on-grep) ':ignore-on-read-text)
- ((on-cmd) nil)
- ((on-close-all) nil))
+ (pcase event
+ (`on-open-all ':ignore-on-open-all)
+ (`on-grep ':ignore-on-read-text)
+ (`on-cmd nil)
+ (`on-close-all nil))
nil t)))
(defun filesets-filetype-get-prop (property filename &optional entry)
(defun filesets-get-fileset-from-name (name &optional mode)
"Get fileset definition for NAME."
- (case mode
- ((:ingroup :tree)
- name)
- (t
- (assoc name filesets-data))))
+ (pcase mode
+ ((or `:ingroup `:tree) name)
+ (_ (assoc name filesets-data))))
;;; commands
Assume MODE (see `filesets-entry-mode'), if provided."
(let* ((mode (or mode
(filesets-entry-mode entry)))
- (fl (case mode
- ((:files)
+ (fl (pcase mode
+ (:files
(filesets-entry-get-files entry))
- ((:file)
+ (:file
(list (filesets-entry-get-file entry)))
- ((:ingroup)
+ (:ingroup
(let ((entry (expand-file-name
(if (stringp entry)
entry
(filesets-entry-get-master entry)))))
(cons entry (filesets-ingroup-cache-get entry))))
- ((:tree)
+ (:tree
(let ((dir (nth 0 entry))
(patt (nth 1 entry)))
(filesets-directory-files dir patt ':files t)))
- ((:pattern)
+ (:pattern
(let ((dirpatt (filesets-entry-get-pattern entry)))
(if dirpatt
(let ((dir (filesets-entry-get-pattern--dir dirpatt))
n name)))
(dolist (this files nil)
(filesets-file-open open-function this))
- (message "Filesets: cancelled")))
+ (message "Filesets: canceled")))
(filesets-error 'error "Filesets: Unknown fileset: " name))))
(defun filesets-close (&optional mode name lookup-name)
(let* ((result nil)
(factor (ceiling (/ (float bl)
filesets-max-submenu-length))))
- (do ((data submenu-body (cdr data))
- (n 1 (+ n 1))
- (count 0 (+ count factor)))
+ (cl-do ((data submenu-body (cdr data))
+ (n 1 (+ n 1))
+ (count 0 (+ count factor)))
((or (> count bl)
(null data)))
-; (let ((sl (subseq submenu-body count
+ ;; (let ((sl (subseq submenu-body count
(let ((sl (filesets-sublist submenu-body count
(let ((x (+ count factor)))
(if (>= bl x)
`((,(concat
(filesets-get-shortcut n)
(let ((rv ""))
- (do ((x sl (cdr x)))
+ (cl-do ((x sl (cdr x)))
((null x))
(let ((y (concat (elt (car x) 0)
(if (null (cdr x))
"Get submenu epilog for SOMETHING (usually a fileset).
If mode is :tree or :ingroup, SOMETHING is some weird construct and
LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
- (case mode
- ((:tree)
+ (pcase mode
+ (:tree
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:ingroup)
+ (:ingroup
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:pattern)
+ (:pattern
`("---"
["Close all files" (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:files)
+ (:files
`("---"
[,(concat "Close all files") (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- (t
+ (_
(filesets-error 'error "Filesets: malformed definition of " something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
(fn (or fun (lambda (a b)
(and (stringp a)
(stringp b)
- (string-match a b))))))
+ (string-match-p a b))))))
(filesets-some (lambda (x)
(if (funcall fn (car x) masterfile)
(nth pos x)
(filesets-verbosity (filesets-entry-get-verbosity entry))
(this-lookup-name (concat (filesets-get-shortcut count)
lookup-name)))
- (case mode
- ((:file)
+ (pcase mode
+ (:file
(let* ((file (filesets-entry-get-file entry)))
`[,this-lookup-name
(filesets-file-open nil ',file ',lookup-name)]))
- (t
+ (_
`(,this-lookup-name
- ,@(case mode
- ((:pattern)
+ ,@(pcase mode
+ (:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
(pattname (apply 'concat (cons "Pattern: " dirpatt)))
files))
,@(filesets-get-menu-epilog lookup-name mode
lookup-name t))))
- ((:ingroup)
+ (:ingroup
(let* ((master (filesets-entry-get-master entry)))
;;(filesets-message 3 "Filesets: parsing %S" master)
`([,(concat "Inclusion Group: "
,@(filesets-wrap-submenu
(filesets-build-ingroup-submenu lookup-name master))
,@(filesets-get-menu-epilog master mode lookup-name t))))
- ((:tree)
+ (:tree
(let* ((dirpatt (filesets-entry-get-tree entry))
(dir (car dirpatt))
(patt (cadr dirpatt)))
(filesets-build-dir-submenu entry lookup-name dir patt)))
- ((:files)
+ (:files
(let ((files (filesets-get-filelist entry mode 'on-open-all))
(count 0))
`([,(concat "Files: " lookup-name)
(setq filesets-has-changed-flag nil)
(setq filesets-updated-buffers nil)
(setq filesets-update-cache-file-flag t)
- (do ((data (filesets-conditional-sort filesets-data (function car))
- (cdr data))
- (count 1 (+ count 1)))
+ (cl-do ((data (filesets-conditional-sort filesets-data (function car))
+ (cdr data))
+ (count 1 (+ count 1)))
((null data))
(let* ((this (car data))
(name (filesets-data-get-name this))
(when filesets-cache-hostname-flag
(insert (format "(setq filesets-cache-hostname %S)" (system-name)))
(newline 2))
- (run-hooks 'filesets-cache-fill-content-hooks)
+ (run-hooks 'filesets-cache-fill-content-hook)
(write-file filesets-menu-cache-file))
(setq filesets-has-changed-flag nil)
(setq filesets-update-cache-file-flag nil)))
HCoop / bpt / emacs.git / blobdiff