fink.el

   1 ;;; fink.el --- fink administration within Emacs
   2
   3 ;; Copyright (C) 2007, 2008 William Xu
   4
   5 ;; Author: William Xu <william.xwl@gmail.com>
   6 ;; Version: 0.3
   7 ;; Url: http://xwl.appspot.com/ref/fink.el
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 3, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with EMMS; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This package tries to simply fink daily administration work(not all
  27 ;; but most frequent commands) by using Emacs' ido features for
  28 ;; completing package names. It's modelled after `wajig.el' which I
  29 ;; wrote for Debian GNU/Linux.
  30
  31 ;; Put this file into your load-path and the following into your
  32 ;; ~/.emacs:
  33 ;;           (require 'fink)
  34
  35 ;;; Code:
  36
  37 (require 'ansi-color)
  38
  39 ;;; Customizations
  40
  41 (defgroup fink nil
  42   "An interface for fink in macosx."
  43   :group 'fink)
  44
  45 (defcustom fink-mode-hook nil
  46   "Normal hook run after entering fink mode."
  47   :type 'hook
  48   :group 'fink)
  49
  50 (defcustom fink-cache-filename "~/.fink-cache.el"
  51   "Fink cache file."
  52   :type 'string
  53   :group 'fink)
  54
  55 \f
  56 ;;; Fink Mode
  57
  58 ;;;###autoload
  59 (defun fink ()
  60   "Create a *fink* buffer."
  61   (interactive)
  62   (let ((fink-exist-p (get-buffer "*fink*")))
  63     (switch-to-buffer "*fink*")
  64     (unless fink-exist-p
  65       (fink-mode))))
  66
  67 (defvar fink-mode-map
  68   (let ((map (make-sparse-keymap)))
  69     (define-key map "E" 'fink-edit-sources)
  70     (define-key map "h" 'fink-mode-help)
  71
  72     (define-key map "i" 'fink-install)
  73     (define-key map "I" 'fink-install-at-point)
  74     (define-key map "K" 'fink-kill)
  75     (define-key map "o" 'fink-describe)
  76     (define-key map "d" 'fink-fetch)
  77
  78     (define-key map "R" 'fink-remove)
  79     (define-key map "S" 'fink-apropos)
  80     (define-key map "s" 'fink-describe)
  81     (define-key map "u" 'fink-selfupdate)
  82     (define-key map "U" 'fink-update-all)
  83     (define-key map "
" 'fink-show-at-point)
  84
  85     ;; services control
  86     (define-key map (kbd "V x") 'fink-service-start)
  87     (define-key map (kbd "V v") 'fink-service-stop)
  88     (define-key map (kbd "V r") 'fink-service-restart)
  89     ;; cursor movement
  90     (define-key map "n" 'next-line)
  91     (define-key map "p" 'previous-line)
  92
  93     ;; dpkg commands
  94     (define-key map "L" 'fink-list-installed-files)
  95     map)
  96   "Keymap for `fink-mode'.")
  97
  98 (defvar fink-font-lock-keywords
  99   '(("^\n\\([a-zA-Z0-9].*: \\)\\(.*\\)"
 100      (1 font-lock-keyword-face nil t)
 101      (2 font-lock-function-name-face nil t))
 102     ("Web site:\\|Maintainer:"
 103      (0 font-lock-keyword-face t t)))
 104   "Keywords to highlight in fink mode.")
 105
 106 (define-derived-mode fink-mode nil "Fink"
 107   "Major mode for fink.
 108 \\{fink-mode-map}"
 109   (fink-mode-help)
 110   (set-syntax-table fink-mode-syntax-table)
 111   (setq font-lock-defaults '(fink-font-lock-keywords))
 112   (unless fink-available-pkgs
 113     (if (file-readable-p fink-cache-filename)
 114         (load-file fink-cache-filename)
 115       (fink-update-cache)))
 116   (run-hooks 'fink-mode-hook))
 117
 118 (defun fink-mode-help ()
 119   "Help page for fink-mode."
 120   (interactive)
 121   (message "For a list of available key bindings, press `F1 m' or `C-h m'."))
 122
 123 (defvar fink-mode-syntax-table
 124   (let ((st (make-syntax-table)))
 125     (modify-syntax-entry ?- "w" st)
 126     (modify-syntax-entry ?/ "w" st)
 127     st)
 128   "Syntax table used while in `fink-mode'.")
 129
 130 \f
 131 ;;; define-fink-command
 132
 133 (defvar fink-process nil)
 134 (defvar fink-running nil)
 135
 136 (defalias 'fink-completing-read
 137   (if (and (fboundp 'ido-completing-read)
 138            ido-mode)
 139       'ido-completing-read              ; added since Emacs 22
 140     'completing-read))
 141
 142 (defun fink-process-sentinel (process event)
 143   (setq fink-running nil)
 144   (save-excursion
 145     (with-current-buffer (get-buffer "*fink*")
 146       (let ((inhibit-read-only t))
 147         (case (process-status process)
 148           ((exit)
 149            (goto-char (point-max))
 150            (insert "------------- done --------------\n"))
 151           ((signal)
 152            (message "fink process killed")))))))
 153
 154 (defun fink-process-filter (process output)
 155   (with-current-buffer (process-buffer process)
 156     (let ((moving (= (point) (process-mark process)))
 157           (inhibit-read-only t))
 158       (save-excursion
 159         (goto-char (process-mark process))
 160         (insert (replace-regexp-in-string "
" "" output))
 161         (set-marker (process-mark process) (point)))
 162       (and moving (goto-char (process-mark process)))
 163       (let ((ansi-color-for-comint-mode t))
 164         (ansi-color-process-output "")))))
 165
 166 (defun fink-kill ()
 167   "Kill running fink process."
 168   (interactive)
 169   (when fink-process
 170     (unless (eq (process-status fink-process) 'exit)
 171       (delete-process fink-process))
 172     (setq fink-running nil)))
 173
 174 (defvar fink-available-pkgs nil
 175   "Installed packages on the system.
 176 You can run `fink-update-cache' to keep update.")
 177
 178 (defvar fink-services nil
 179   "Existing services' list.
 180 You can run `fink-update-cache' to keep update.")
 181
 182 (defun fink-update-cache ()
 183   "Update fink cache saved in `fink-cache-filename'."
 184   (interactive)
 185   (message "Updating fink cache...")
 186   (fink-update-available-pkgs)
 187   (fink-update-services)
 188   ;; (fink-update-command-path-alist)
 189   (with-temp-buffer
 190     (insert ";; automatically generated by fink.el\n")
 191     (insert (format "
 192 \(setq fink-available-pkgs '%S
 193       fink-services '%S)
 194 "
 195                     fink-available-pkgs
 196                     fink-services))
 197     (write-region (point-min) (point-max) fink-cache-filename))
 198   (message "Updating fink cache...done"))
 199
 200 (defun fink-update-available-pkgs ()
 201   "Update `fink-available-pkgs'."
 202   (setq fink-available-pkgs
 203         (split-string
 204          (shell-command-to-string
 205           ;; FIXME: Why doesn't "sed 's/.\{4\}'"  work?
 206           "fink list | sed 's/....//' | awk '{print $1}'"))))
 207
 208 (defun fink-update-services ()
 209   (setq fink-services
 210         (split-string (shell-command-to-string "service --list"))))
 211
 212 (defmacro define-fink-command (command &optional arglist)
 213   "Define a new fink command. COMMAND is one of fink commands,
 214 such as help, update. Optional ARGLIST is (pkg). e.g.,
 215
 216     (define-fink-command help)
 217     (define-fink-command show (pkg))
 218
 219 pkg is the package name to operate on."
 220   (when (symbolp command)
 221     (setq command (symbol-name command)))
 222   (let* ((fink-command (intern (format "fink-%s" command)))
 223          (docstring ;; show help from `fink --help'
 224           (let ((help (shell-command-to-string "fink --help")))
 225             (if (string-match (format "^  %s      - .*" command) help)
 226                 (match-string 0 help)
 227               "")))
 228          (interactive
 229           (if arglist
 230               (setq interactive
 231                     `(interactive
 232                       (list
 233                        (fink-completing-read
 234                         ;; Assume `yes' for all interactive questions.
 235                         ,(format "$ sudo fink --yes --quiet %s " command)
 236                         fink-available-pkgs))))
 237             '(interactive))))
 238     `(defun ,fink-command ,arglist
 239        ,docstring
 240        ,interactive
 241        (let ((inhibit-read-only t))
 242          (fink)
 243          (if fink-running
 244              (error "Fink process already exists")
 245            (erase-buffer)
 246            (setq fink-running t)
 247            (setq fink-process
 248                  ,(if arglist
 249                       `(start-process "fink" "*fink*"
 250                                       "sudo" "fink" "--yes" "--quiet" ,command  ,(car arglist))
 251                     `(start-process "fink" "*fink*"
 252                                     "sudo" "fink" "--yes" "--quiet" ,command)))
 253            (set-process-filter fink-process 'fink-process-filter)
 254            (set-process-sentinel fink-process 'fink-process-sentinel))))))
 255
 256 (define-fink-command install (pkg))
 257 (define-fink-command remove (pkg))
 258 (define-fink-command purge (pkg))
 259 (define-fink-command update (pkg))
 260 (define-fink-command apropos (pkg))
 261 (define-fink-command describe (pkg))
 262 (define-fink-command fetch (pkg))
 263
 264 (define-fink-command selfupdate)
 265 (define-fink-command update-all)
 266 (define-fink-command list)
 267 (define-fink-command cleanup)
 268 (define-fink-command index)
 269 (define-fink-command validate)
 270 (define-fink-command configure)
 271 (define-fink-command scanpackages)
 272 (define-fink-command show-deps)
 273
 274 (defun fink-show-at-point ()
 275   "Run `fink describe' on current word(pkg name)."
 276   (interactive)
 277   (fink-describe (current-word)))
 278
 279 (defun fink-install-at-point ()
 280   "Run `fink install' on current word(pkg name)."
 281   (interactive)
 282   (fink-install (current-word)))
 283
 284 \f
 285 ;;; fink-command, fink-dpkg-command
 286
 287 (defun fink-command (command-string)
 288   "Run COMMAND-STRING, e.g., '(\"cmd\" \"arg1\" ...) in *fink*
 289 buffer."
 290   (let ((inhibit-read-only t))
 291     (fink)
 292     (erase-buffer)
 293     (if fink-running
 294         (error "Fink process already exists")
 295       (setq fink-running t)
 296       (setq fink-process
 297             (apply 'start-process "fink" "*fink*" command-string))
 298       (set-process-filter fink-process 'fink-process-filter)
 299       (set-process-sentinel fink-process 'fink-process-sentinel))))
 300
 301 ;; Service Control
 302
 303 (defun fink-service-start (service)
 304   (interactive
 305    (list
 306     (ido-completing-read "Start service: " fink-services)))
 307   (fink-command (list "sudo" "service" service "start")))
 308
 309 (defun fink-service-stop (service)
 310   (interactive
 311    (list
 312     (ido-completing-read "Stop service: " fink-services)))
 313   (fink-command (list "sudo" "service" service "stop")))
 314
 315 (defun fink-service-restart (service)
 316   (interactive
 317    (list
 318     (ido-completing-read "Restart service: " fink-services)))
 319   (fink-service-stop service)
 320   (fink-service-start service))
 321
 322 (defun fink-edit-sources ()
 323   (interactive)
 324   (find-file "/sudo::/sw/etc/fink.conf"))
 325
 326 ;; dpkg interfaces, if dpkg commands grows here, i'll add a
 327 ;; define-dpkg-command, but not now.
 328 (defun fink-list-installed-files (pkg)
 329   (interactive
 330    (list
 331     (ido-completing-read "List files installed by: " fink-available-pkgs)))
 332   (fink-command (list "sudo" "dpkg" "-L" pkg)))
 333
 334 (provide 'fink)
 335
 336 ;;; fink.el ends here