Commit | Line | Data |
---|---|---|
acc33231 CY |
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. | |
0f008bd3 CY |
129 | |
130 | ;;;###autoload | |
acc33231 CY |
131 | (defun ede-vc-project-directory () |
132 | "Run `vc-dir' on the current project." | |
133 | (interactive) | |
134 | (let ((top (ede-toplevel-project-or-nil default-directory))) | |
135 | (vc-dir top nil))) | |
136 | ||
137 | (provide 'ede/system) | |
138 | ||
0f008bd3 CY |
139 | ;; Local variables: |
140 | ;; generated-autoload-file: "loaddefs.el" | |
141 | ;; generated-autoload-feature: ede/loaddefs | |
142 | ;; generated-autoload-load-name: "ede/system" | |
143 | ;; End: | |
144 | ||
acc33231 | 145 | ;;; ede/system.el ends here |