lisp/cedet/ede/system.el

   1 ;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
   2
   3 ;;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: project, make, vc
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs 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 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; EDE system contains some routines to work with EDE projects saved in
  26 ;; CVS repositories, and services such as sourceforge which lets you
  27 ;; perform releases via FTP.
  28
  29 (require 'ede)
  30
  31 ;;; Code:
  32
  33 ;;; Web/FTP site node.
  34 ;;
  35 (defun ede-web-browse-home ()
  36   "Browse the home page of the current project."
  37   (interactive)
  38   (if (not (ede-toplevel))
  39       (error "No project"))
  40   (let ((home (oref (ede-toplevel) web-site-url)))
  41     (if (string= "" home)
  42         (error "Now URL is stored in this project"))
  43     (require 'browse-url)
  44     (browse-url home)
  45     ))
  46
  47
  48 (defun ede-edit-web-page ()
  49   "Edit the web site for this project."
  50   (interactive)
  51   (let* ((toplevel (ede-toplevel))
  52          (dir (oref toplevel web-site-directory))
  53          (file (oref toplevel web-site-file))
  54          (endfile (concat (file-name-as-directory dir) file)))
  55     (if (string-match "^/r[:@]" endfile)
  56         (require 'tramp))
  57     (when (not (file-exists-p endfile))
  58       (setq endfile file)
  59       (if (string-match "^/r[:@]" endfile)
  60           (require 'tramp))
  61       (if (not (file-exists-p endfile))
  62           (error "No project file found")))
  63     (find-file endfile)))
  64
  65
  66 (defun ede-upload-distribution ()
  67   "Upload the current distribution to the correct location.
  68 Use /user@ftp.site.com: file names for FTP sites.
  69 Download tramp, and use /r:machine: for names on remote sites w/out FTP access."
  70   (interactive)
  71   (let* ((files (project-dist-files (ede-toplevel)))
  72          (upload (if (string= (oref (ede-toplevel) ftp-upload-site) "")
  73                      (oref (ede-toplevel) ftp-site)
  74                    (oref (ede-toplevel) ftp-upload-site))))
  75     (when (or (string= upload "")
  76               (not (file-exists-p upload)))
  77       (error "Upload directory %S does not exist" upload))
  78     (while files
  79       (let ((localfile (concat (file-name-directory (oref (ede-toplevel) file))
  80                                (car files))))
  81         (if (not (file-exists-p localfile))
  82             (progn
  83               (message "File %s does not exist yet.  Building a distribution"
  84                        localfile)
  85               (ede-make-dist)
  86               (error "File %s does not exist yet.  Building a distribution"
  87                      localfile)
  88               ))
  89         (setq upload
  90               (concat (directory-file-name upload)
  91                       "/"
  92                       (file-name-nondirectory localfile)))
  93         (copy-file localfile upload)
  94         (setq files (cdr files)))))
  95   (message "Done uploading files...")
  96   )
  97
  98 (defun ede-upload-html-documentation ()
  99   "Upload the current distributions documentation as HTML.
 100 Use /user@ftp.site.com: file names for FTP sites.
 101 Download tramp, and use /r:machine: for names on remote sites w/out FTP access."
 102   (interactive)
 103   (let* ((files nil) ;(ede-html-doc-files (ede-toplevel)))
 104          (upload (if (string= (oref (ede-toplevel) ftp-upload-site) "")
 105                      (oref (ede-toplevel) ftp-site)
 106                    (oref (ede-toplevel) ftp-upload-site))))
 107     (when (or (string= upload "")
 108               (not (file-exists-p upload)))
 109       (error "Upload directory %S does not exist" upload))
 110     (while files
 111       (let ((localfile (concat (file-name-directory (oref (ede-toplevel) file))
 112                                (car files))))
 113         (if (not (file-exists-p localfile))
 114             (progn
 115               (message "File %s does not exist yet.  Building a distribution"
 116                        localfile)
 117               ;;(project-compile-target ... )
 118               (error "File %s does not exist yet.  Building a distribution"
 119                      localfile)
 120               ))
 121         (copy-file localfile upload)
 122         (setq files (cdr files)))))
 123   (message "Done uploading files...")
 124   )
 125
 126 ;;; Version Control
 127 ;;
 128 ;; Do a few nice things with Version control systems.
 129 (defun ede-vc-project-directory ()
 130   "Run `vc-dir' on the current project."
 131   (interactive)
 132   (let ((top (ede-toplevel-project-or-nil default-directory)))
 133     (vc-dir top nil)))
 134
 135 (provide 'ede/system)
 136
 137 ;;; ede/system.el ends here