summaryrefslogtreecommitdiff
path: root/devscripts.el
blob: 8d37f93317940581016cfefaedfe7f845f27a80c (plain)
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
;; Routines to do devscripts-compatible emacs routines.
;; copyright 2002 Junichi Uekawa.

;; This file 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 2, or (at your option)
;; any later version.
;;
;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.

(require 'pbuilder-log-view-mode)
(require 'comint)

(defgroup devscripts nil "devscripts mode"
  :group 'tools
  :prefix "devscripts-")


(defcustom debuild-option-list '("-i" "-uc" "-us") "*Options to give to debuild."
  :type '(repeat string)
  :group 'devscripts)
(defconst devscripts-mode-version "$Id$" "Version of devscripts mode.")

(defun devscripts-internal-get-debian-package-name ()
  "Find the directory with debian/ dir, and get the dir name."
  (let* ((looking-dir (expand-file-name (concat default-directory "."))))
    (while (not (file-accessible-directory-p (concat looking-dir "/debian")))
      (progn 
	(if (string= looking-dir "/")
	    (error "Cannot find debian dir anywhere"))
	(setq looking-dir (expand-file-name (expand-file-name (concat looking-dir "/.."))))))
    (file-name-nondirectory looking-dir)))

(defun debuild ()
  "Run debuild in the current directory."
  (interactive)
  (let* ((debuild-buffer (concat "*debuild*" default-directory))
	 (debuild-process (concat "debuild-process-" default-directory))
	 (package-name (devscripts-internal-get-debian-package-name)))
    (switch-to-buffer debuild-buffer)
    (toggle-read-only 0)
    (kill-region (point-min) (point-max))
    (compilation-mode)    
    (pbuilder-log-view-add package-name debuild-buffer (apply 'start-process debuild-process debuild-buffer "/usr/bin/debuild" debuild-option-list))))

(defun debi ()
  "Run debi in the current directory, to install debian packages generated by previous invocation of debuild."
  (interactive)
  (let* ((debi-name (concat "debi" default-directory))
	 (debi-buffer-name (concat "*" debi-name "*")))
    (make-comint debi-name devscripts-mode-gain-root-command
		 nil "/usr/bin/debi")
    (switch-to-buffer debi-buffer-name)))

(defun debit ()
  "Run debit in the current directory, to install debian packages generated by previous invocation of debuild."
  (interactive)
  (let* ((debit-buffer (concat "*debit*" default-directory))
	 (debit-process (concat "debit-process-" default-directory)))
    (switch-to-buffer debit-buffer)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (start-process debit-process debit-buffer devscripts-mode-gain-root-command "/usr/bin/debit")))


(defun debc ()
  "Run debc in the current directory, to install debian packages generated by previous invocation of debuild."
  (interactive)
  (let* ((debc-buffer (concat "*debc*" default-directory))
	 (debc-process (concat "debc-process-" default-directory)))
    (switch-to-buffer debc-buffer)
    (kill-region (point-min) (point-max))
    (devscripts-debc-mode)
    (start-process debc-process debc-buffer "/usr/bin/debc")))

(defun debclean ()
  "Run debclean in the current directory, to clean the debian build tree."
  (interactive)
  (let* ((debclean-buffer (concat "*debclean*" default-directory))
	 (debclean-process (concat "debclean-process-" default-directory)))
    (switch-to-buffer debclean-buffer)
    (kill-region (point-min) (point-max))
    (compilation-mode)
    (start-process debclean-process debclean-buffer "/usr/bin/debclean")))

(defun debdiff (changes-file-1 changes-file-2)
  "Compare contents of CHANGES-FILE-1 and CHANGES-FILE-2."
  (interactive "fFirst Changes file: \nfSecond Changes File: ")
  (let* ((debdiff-buffer (concat "*debdiff*" default-directory))
	 (debdiff-process (concat "debdiff-process-" default-directory)))
    (switch-to-buffer debdiff-buffer)
    (kill-region (point-min) (point-max))
    (start-process debdiff-process debdiff-buffer "/usr/bin/debdiff" 
		   (expand-file-name changes-file-1)
		   (expand-file-name changes-file-2))))

(defun debdiff-current ()
  "Compare the contents of .changes file of current version with previous version; 
requires access to debian/changelog, and being in debian/ dir."
  (interactive)
  (let* ((debdiff-buffer (concat "*debdiff*" default-directory))
	 (debdiff-process (concat "debdiff-process-" default-directory))
	 (debug-on-error t)
	 newversion oldversion pkgname changes-file-1 changes-file-2)
    (find-file "changelog")
    (save-excursion 
      (goto-char (point-min))
      (re-search-forward "^\\(\\S-+\\) +(\\([^:)]*:\\)?\\([^)]*\\))" nil t)
      (setq newversion (match-string 3))
      (setq pkgname (match-string 1))
      (re-search-forward "^\\(\\S-+\\) +(\\([^:)]*:\\)?\\([^)]*\\))" nil t)
      (setq oldversion (match-string 3)))
    (setq changes-file-1
	  (car (file-expand-wildcards (concat default-directory "../../" pkgname "_" oldversion "_*.changes"))))
    (setq changes-file-2
	  (car (file-expand-wildcards (concat default-directory "../../" pkgname "_" newversion "_*.changes"))))
    (princ pkgname)
    (princ oldversion)
    (princ changes-file-1)
    (princ changes-file-2)
    (switch-to-buffer debdiff-buffer)
    (kill-region (point-min) (point-max))
    (insert (concat 
	     "Comparing " 
	     (file-name-nondirectory changes-file-1) " and " 
	     (file-name-nondirectory changes-file-2)  "\n"))
    (start-process debdiff-process debdiff-buffer "/usr/bin/debdiff" 
		   (expand-file-name changes-file-1)
		   (expand-file-name changes-file-2))))

(defun devscripts-debc-mode ()
  "Mode to view debc output.
\\{devscripts-debc-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'devscripts-debc-mode)
  (setq mode-name "debc")
  (mapcar 'make-local-variable '(font-lock-defaults))
  (use-local-map devscripts-debc-mode-map)
  (set-syntax-table devscripts-debc-mode-syntax-table)
  (setq font-lock-defaults 
	'(
					;keywords start here
	  (("^[a-z].*deb$" . font-lock-string-face)
	   ("^ \\([A-Z][-A-Za-z]+:\\)\\(.*\\)$" (1 font-lock-keyword-face) (2 font-lock-warning-face))
	   ("^[^ ].*$" . font-lock-comment-face)
	   )
	  nil		;keywords-only
	  nil		;case-fold
	  ()		;syntax-alist
	  ))
  (run-hooks 'devscripts-debc-mode-hook)
)

(defvar devscripts-debc-mode-map nil "Keymap for devscripts debc mode.")
(defvar devscripts-debc-mode-syntax-table nil "Syntax table for devscripts debc mode.")
(if devscripts-debc-mode-syntax-table
         ()              ; Do not change the table if it is already set up.
       (setq devscripts-debc-mode-syntax-table (make-syntax-table))
       (modify-syntax-entry ?\" ".   " devscripts-debc-mode-syntax-table)
       (modify-syntax-entry ?\\ ".   " devscripts-debc-mode-syntax-table)
       (modify-syntax-entry ?' "w   " devscripts-debc-mode-syntax-table))
(defcustom devscripts-mode-gain-root-command "/usr/bin/sudo" "*The command used to gain root for running debi and debit."
  :group 'devscripts
  :type 'file)
(defcustom devscripts-mode-load-hook nil "*Hooks that are run when devscripts-mode is loaded."
  :group 'devscripts
  :type 'hook)
(run-hooks 'devscripts-mode-load-hook)
(provide 'devscripts)