system.el 4.6 KB

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