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