extensions/anything-obsolete.el

   1 ;;;; anything-obsolete.el --- obsolete functions of anything
   2 ;; Time-stamp: <2010-11-18 11:02:25 rubikitch>
   3
   4 ;; Copyright (C) 2010  rubikitch
   5
   6 ;; Author: rubikitch <rubikitch@ruby-lang.org>
   7 ;; Keywords: tools, files
   8 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-obsolete.el
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; Obsolete functions and commands are moved here.
  28 ;;
  29 ;; - `read-file-name' and `find-file' replacement
  30 ;;     There are here because anything-ized `read-file-name' slows down and has odd interface
  31 ;;     If you still want to use them, add to ~/.emacs like this:
  32 ;;       (anything-read-string-mode '(string file buffer variable command))
  33 ;;
  34
  35 ;;; Commands:
  36 ;;
  37 ;; Below are complete command list:
  38 ;;
  39 ;;  `anything-read-file-name-follow-directory'
  40 ;;    Follow directory in `anything-read-file-name'.
  41 ;;  `anything-find-file'
  42 ;;    Replacement of `find-file'.
  43 ;;
  44 ;;; Customizable Options:
  45 ;;
  46 ;; Below are customizable option list:
  47 ;;
  48
  49 ;;; Change log:
  50 ;;
  51 ;;  Change log of this file is found at
  52 ;;  http://repo.or.cz/w/anything-config.git/history/master:/anything-obsolete.el
  53 ;;
  54 ;;  Change log of this project is found at
  55 ;;  http://repo.or.cz/w/anything-config.git?a=shortlog
  56
  57 ;;; Code:
  58
  59 (require 'anything)
  60
  61 ;; (@* "`read-file-name' compatible read function ")
  62 (defvar anything-read-file-name-map nil)
  63 (defvar arfn-followed nil)
  64 (defvar arfn-dir nil)
  65 (defun anything-read-file-name-map ()
  66   "Lazy initialization of `anything-read-file-name-map'."
  67   (unless anything-read-file-name-map
  68     (setq anything-read-file-name-map (copy-keymap anything-map))
  69     (define-key anything-read-file-name-map "\C-i" 'anything-read-file-name-follow-directory)
  70     (define-key anything-read-file-name-map [tab] 'anything-read-file-name-follow-directory))
  71   anything-read-file-name-map)
  72
  73 (defun anything-read-file-name-follow-directory ()
  74   "Follow directory in `anything-read-file-name'."
  75   (interactive)
  76   ;; These variables are bound by `arfn-sources' or `anything-find-file'.
  77   (declare (special prompt default-filename require-match predicate additional-attrs))
  78   (setq arfn-followed t)
  79   (let* ((sel (anything-get-selection))
  80          (f (expand-file-name sel arfn-dir)))
  81     (cond ((and (file-directory-p f) (not (string-match "/\\.$" sel)))
  82            (with-selected-window (minibuffer-window) (delete-minibuffer-contents))
  83            (setq anything-pattern "")
  84            ;;(setq arfn-dir f)
  85            (anything-set-sources
  86             (arfn-sources
  87              prompt f default-filename require-match nil predicate additional-attrs))
  88            (anything-update))
  89           ((string-match "^\\(.+\\)/\\([^/]+\\)$" sel)
  90            (with-selected-window (minibuffer-window)
  91              (delete-minibuffer-contents)
  92              (insert (match-string 2 sel)))
  93            (anything-set-sources
  94             (arfn-sources
  95              prompt (expand-file-name (match-string 1 sel) arfn-dir) nil require-match (match-string 2 sel) predicate additional-attrs))
  96            (anything-update)))))
  97
  98 (defun* anything-read-file-name (prompt &optional dir default-filename require-match initial-input predicate (additional-attrs '((action . identity))))
  99   "`anything' replacement for `read-file-name'."
 100   (setq arfn-followed nil)
 101   (let* ((anything-map (anything-read-file-name-map))
 102          anything-input-idle-delay
 103          (result (or (anything-noresume (arfn-sources
 104                                          prompt dir default-filename require-match
 105                                          initial-input predicate additional-attrs)
 106                                         initial-input prompt nil nil "*anything complete*")
 107                      (keyboard-quit))))
 108     (when (and require-match
 109                (not (and (file-exists-p result)
 110                          (funcall (or predicate 'identity) result))))
 111       (error "anything-read-file-name: file `%s' is not matched" result))
 112     (when (stringp result)
 113       (prog1 result
 114         (add-to-list 'file-name-history result)
 115         (setq file-name-history (cons result (delete result file-name-history)))))))
 116
 117 (defun arfn-candidates (dir)
 118   (if (file-directory-p dir)
 119       (loop for (f _ _ _ _ _ _ _ _ perm _ _ _) in (directory-files-and-attributes dir t)
 120             for basename = (file-name-nondirectory f)
 121             when (string= "d" (substring perm 0 1))
 122             collect (cons (concat basename "/") f)
 123             else collect (cons basename f))))
 124
 125 (defun* arfn-sources (prompt dir default-filename require-match initial-input predicate &optional (additional-attrs '((action . identity))))
 126   (setq arfn-dir dir)
 127   (let* ((dir (or dir default-directory))
 128          (transformer-func
 129           (if predicate
 130               `(candidate-transformer
 131                 . (lambda (cands)
 132                     (remove-if-not
 133                      (lambda (c) (,predicate (if (consp c) (cdr c) c))) cands)))))
 134          (new-input-source (ac-new-input-source
 135                             prompt nil
 136                             (append '((display-to-real . (lambda (f) (expand-file-name f arfn-dir))))
 137                                     additional-attrs)))
 138          (history-source (unless require-match
 139                            `((name . "History")
 140                              (candidates . file-name-history)
 141                              (persistent-action . find-file)
 142                              ,@additional-attrs))))
 143     `(((name . "Default")
 144        (candidates . ,(if default-filename (list default-filename)))
 145        (persistent-action . find-file)
 146        (filtered-candidate-transformer
 147         . (lambda (cands source)
 148             (if (and (not arfn-followed) (string= anything-pattern "")) cands nil)))
 149        (display-to-real . (lambda (f) (expand-file-name f ,dir)))
 150        ,@additional-attrs)
 151       ((name . ,dir)
 152        (candidates . (lambda () (arfn-candidates ,dir)))
 153        (persistent-action . find-file)
 154        ,@additional-attrs
 155        ,transformer-func)
 156       ,new-input-source
 157       ,history-source)))
 158 ;; (anything-read-file-name "file: " "~" ".emacs")
 159 ;; (anything-read-file-name "file: " "~" ".emacs" t)
 160 ;; (anything-read-file-name "file: " "~" )
 161 ;; (anything-read-file-name "file: ")
 162 ;; (read-file-name "file: " "/tmp")
 163
 164
 165 ;;; (@* "find-file compatible command")
 166 (defvar anything-find-file-additional-sources nil)
 167 (defun anything-find-file ()
 168   "Replacement of `find-file'."
 169   (interactive)
 170   (let ((anything-map (anything-read-file-name-map))
 171         ;; anything-read-file-name-follow-directory uses these variables
 172         (prompt "Find File: ")
 173         default-filename require-match predicate
 174         (additional-attrs '(;; because anything-c-skip-boring-files cannot
 175                             ;; handle (display . real) candidates
 176                             (candidate-transformer)
 177                             (type . file))))
 178     (anything-other-buffer (append (arfn-sources prompt default-directory
 179                                                  nil nil nil nil additional-attrs)
 180                                    anything-find-file-additional-sources)
 181                            "*anything find-file*")))
 182 ;;(anything-find-file)
 183
 184
 185
 186 (provide 'anything-obsolete)
 187
 188 ;; How to save (DO NOT REMOVE!!)
 189 ;; (progn (magit-push) (emacswiki-post "anything-obsolete.el"))
 190 ;;; anything-obsolete.el ends here