From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 5 Feb 2001 18:55:56 +0000 (+0000)
Subject: New code to do Debian changelogs.
X-Git-Tag: 20090517-FFI~2983
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ef4a2d9e37b9c63bd4f9f4110ed00069b9a04657;p=mit-scheme.git

New code to do Debian changelogs.
---

diff --git a/v7/src/edwin/debian-changelog.scm b/v7/src/edwin/debian-changelog.scm
new file mode 100644
index 000000000..687ab54c1
--- /dev/null
+++ b/v7/src/edwin/debian-changelog.scm
@@ -0,0 +1,264 @@
+;;; -*-Scheme-*-
+;;;
+;;; $Id: debian-changelog.scm,v 1.1 2001/02/05 18:55:45 cph Exp $
+;;;
+;;; Copyright (c) 2001 Massachusetts Institute of Technology
+;;;
+;;; This program 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 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program 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 this package; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
+
+;;;; Debian changelog mode
+
+(declare (usual-integrations))
+
+(define-major-mode debian-changelog text "Debian changelog"
+  "Major mode for editing Debian-style change logs.
+Runs `debian-changelog-mode-hook' if it exists.
+
+Key bindings:
+
+\\{debian-changelog-mode-map}"
+  (lambda (buffer)
+    (local-set-variable! left-margin 2)
+    (local-set-variable! fill-prefix "  ")
+    (local-set-variable! fill-column 74)
+
+    ;; Let each entry behave as one paragraph:
+    (local-set-variable! paragraph-start "\\*")
+    (local-set-variable! paragraph-separate "\\*\\|\\s-*$|\\S-")
+
+    ;; Let each version behave as one page.
+    ;; Match null string on the heading line so that the heading line
+    ;; is grouped with what follows.
+    (local-set-variable! page-delimiter "^\\<")
+    (local-set-variable! version-control 'NEVER)
+
+    (event-distributor/invoke! (ref-variable debian-changelog-mode-hook buffer)
+			       buffer)))
+
+(define-variable debian-changelog-mode-hook
+  "An event distributor that is invoked when entering Debian changelog mode."
+  (make-event-distributor))
+
+(define-key 'debian-changelog '(#\C-c #\C-a) 'debian-changelog-add-entry)
+(define-key 'debian-changelog '(#\C-c #\C-f)
+  'debian-changelog-finalize-last-version)
+(define-key 'debian-changelog '(#\C-c #\C-c)
+  'debian-changelog-finalize-and-save)
+(define-key 'debian-changelog '(#\C-c #\C-v) 'debian-changelog-add-version)
+(define-key 'debian-changelog '(#\C-c #\C-d) 'debian-changelog-distribution)
+(define-key 'debian-changelog '(#\C-c #\C-u) 'debian-changelog-urgency)
+(define-key 'debian-changelog '(#\C-c #\C-e)
+  'debian-changelog-unfinalize-last-version)
+
+(define-command debian-changelog-add-version
+  "Add a new version section to a debian-style changelog file."
+  ()
+  (lambda ()
+    (let ((buffer (selected-buffer)))
+      (if (not (version-finalized? buffer))
+	  (error "Previous version not yet finalized."))
+      (let* ((finish
+	      (lambda (package version)
+		(let ((m (mark-left-inserting-copy (buffer-start buffer))))
+		  (insert-string package m)
+		  (insert-string " (" m)
+		  (insert-string version m)
+		  (insert-string ") unstable; urgency=low" m)
+		  (insert-newlines 2 m)
+		  (insert-string "  * " m)
+		  (insert-newlines 2 m)
+		  (insert-string " --" m)
+		  (insert-newlines 2 m)
+		  (mark-temporary! m))))
+	     (prompt
+	      (lambda ()
+		(let ((package (prompt-for-string "Package name" #f)))
+		  (finish package
+			  (prompt-for-string
+			   "New version (including any revision)"
+			   #f))))))
+	(if (match-title-line buffer #f)
+	    (let ((package
+		   (re-match-extract-string title-regexp-index:package-name))
+		  (version
+		   (re-match-extract-string title-regexp-index:version)))
+	      (let ((regs
+		     (re-string-search-forward "\\([0-9]+\\)$" version)))
+		(if regs
+		    (finish
+		     package
+		     (string-append
+		      (string-head version (re-match-start-index 1 regs))
+		      (number->string
+		       (+ (string->number (re-match-extract version regs 1))
+			  1))))
+		    (prompt))))
+	    (prompt))))))
+
+(define-command debian-changelog-add-entry
+  "Add a new change entry to a debian-style changelog."
+  ()
+  (lambda ()
+    (let ((buffer (selected-buffer)))
+      (if (version-finalized? buffer)
+	  (error
+	   (substitute-command-keys
+	    (string-append
+	     "Most recent version has been finalized - use "
+	     "\\[debian-changelog-unfinalize-last-version] or "
+	     "\\[debian-changelog-add-version]")
+	    buffer)))
+      (let ((m (mark-left-inserting-copy (trailer-line buffer))))
+	(guarantee-newline m)
+	(insert-string "  * " m)
+	(insert-newline m)
+	(mark-temporary! m)
+	(set-current-point! (mark-1+ m))))))
+
+(define-command debian-changelog-distribution
+  "Delete the current distribution and prompt for a new one."
+  ()
+  (lambda ()
+    (set-title-distribution (selected-buffer)
+			    (prompt-for-alist-value
+			     "Select distribution"
+			     (map (lambda (s) (cons s s))
+				  '("stable"
+				    "frozen"
+				    "unstable" 
+				    "stable frozen unstable"
+				    "stable unstable frozen"
+				    "unstable stable frozen"
+				    "unstable frozen stable"
+				    "frozen unstable stable"
+				    "frozen stable unstable"
+				    "frozen unstable"
+				    "unstable frozen"
+				    "stable frozen"
+				    "frozen stable"
+				    "stable unstable"
+				    "unstable stable"))))))
+
+(define-command debian-changelog-urgency
+  "Delete the current urgency and prompt for a new one."
+  ()
+  (lambda ()
+    (set-title-urgency (selected-buffer)
+		       (prompt-for-alist-value
+			"Select urgency"
+			(map (lambda (s) (cons s s))
+			     '("low" "medium" "high" ))))))
+
+(define-command debian-changelog-finalize-and-save
+  "Finalize, if necessary, and then save a debian-style changelog file."
+  ()
+  (lambda ()
+    (let ((buffer (selected-buffer)))
+      (if (not (version-finalized? buffer))
+	  (finalize-last-version buffer))
+      (save-buffer buffer #f))))
+
+(define-command debian-changelog-finalize-last-version
+  "Add the `finalization' information (maintainer's name and email
+address and release date)."
+  ()
+  (lambda () (finalize-last-version (selected-buffer))))
+
+(define (finalize-last-version buffer)
+  (let ((m (mark-left-inserting-copy (trailer-line buffer))))
+    (delete-string m (line-end m 0))
+    (insert-string " " m)
+    (insert-string (or (ref-variable add-log-full-name buffer)
+		       (mail-full-name buffer))
+		   m)
+    (insert-string " <" m)
+    (insert-string (or (ref-variable add-log-mailing-address buffer)
+		       (user-mail-address buffer))
+		   m)
+    (insert-string ">  " m)
+    (insert-string (universal-time->string (get-universal-time)) m)
+    (mark-temporary! m)))
+
+(define-command debian-changelog-unfinalize-last-version
+  "Remove the `finalization' information (maintainer's name and email
+address and release date) so that new entries can be made."
+  ()
+  (lambda ()
+    (let ((buffer (selected-buffer)))
+      (if (not (version-finalized? buffer))
+	  (error "Most recent version is not finalized."))
+      (let ((m (trailer-line buffer)))
+	(delete-string m (line-end m 0))))))
+
+(define (version-finalized? buffer)
+  (let ((m (trailer-line buffer)))
+    (cond ((re-match-forward
+	    "[ \t]+\\S [^\n\t]+\\S  <[^ \t\n<>]+>  \\S [^\t\n]+\\S [ \t]*$"
+	    m)
+	   #t)
+	  ((re-match-forward "[ \t]*$" m) #f)
+	  (else (error "Malformed finalization line.")))))
+
+(define (trailer-line buffer)
+  (let ((start (buffer-start buffer))
+	(end (buffer-end buffer)))
+    (if (not (re-search-forward "\n\\S " start end))
+	(error "Unable to find version-end line."))
+    (let ((m (mark1+ (re-match-start 0))))
+      (if (re-search-backward "\n --"  start)
+	  (re-match-end 0)
+	  (let ((m (mark-left-inserting-copy m)))
+	    (insert-string " --" m)
+	    (insert-newlines 2 m)
+	    (mark-temporary! m)
+	    (mark- m 2))))))
+
+(define (set-title-distribution buffer distribution)
+  (set-title-value buffer title-regexp-index:distribution distribution))
+
+(define (set-title-urgency buffer urgency)
+  (set-title-value buffer title-regexp-index:urgency urgency))
+
+(define (set-title-value buffer index value)
+  (match-title-line buffer #t)
+  (let ((s (mark-left-inserting-copy (re-match-start index)))
+	(e (re-match-end index)))
+    (delete-string s e)
+    (insert-string value s)
+    (mark-temporary! s)))
+
+(define (match-title-line buffer error?)
+  (or (let ((start (buffer-start buffer)))
+	(re-match-forward title-regexp start (line-end start 0)))
+      (and error? (error "Unable to match title line."))))
+
+(define title-regexp
+  (let ((package-name "[a-zA-Z0-9+.-]+")
+	(version "[a-zA-Z0-9+.:-]+"))
+    (string-append "^\\("
+		   package-name
+		   "\\) +(\\("
+		   version
+		   "\\)) \\( *"
+		   package-name
+		   "\\( +"
+		   package-name
+		   "\\)+ *\\);.*"
+		   " urgency=\\([a-zA-Z0-9]+\\)")))
+(define title-regexp-index:package-name 1)
+(define title-regexp-index:version 2)
+(define title-regexp-index:distribution 3)
+(define title-regexp-index:urgency 5)
\ No newline at end of file
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 8b15aaec3..f3ca1d515 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: decls.scm,v 1.69 2000/06/08 18:00:42 cph Exp $
+$Id: decls.scm,v 1.70 2001/02/05 18:55:48 cph Exp $
 
-Copyright (c) 1989-2000 Massachusetts Institute of Technology
+Copyright (c) 1989-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -127,6 +127,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 		"comred"
 		"curren"
 		"dabbrev"
+		"debian-changelog"
 		"debug"
 		"debuge"
 		"dired"
diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm
index c20222f09..72197bc33 100644
--- a/v7/src/edwin/ed-ffi.scm
+++ b/v7/src/edwin/ed-ffi.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: ed-ffi.scm,v 1.50 2000/06/08 18:00:43 cph Exp $
+$Id: ed-ffi.scm,v 1.51 2001/02/05 18:55:50 cph Exp $
 
-Copyright (c) 1990-2000 Massachusetts Institute of Technology
+Copyright (c) 1990-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -94,6 +94,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 		edwin-syntax-table)
     ("dabbrev"	(edwin)
 		edwin-syntax-table)
+    ("debian-changelog" (edwin debian-changelog)
+		edwin-syntax-table)
     ("debug"	(edwin debugger)
 		edwin-syntax-table)
     ("debuge"	(edwin)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 7b35ceef9..28b082c76 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.268 2001/02/05 18:15:55 cph Exp $
+$Id: edwin.pkg,v 1.269 2001/02/05 18:55:53 cph Exp $
 
 Copyright (c) 1989-2001 Massachusetts Institute of Technology
 
@@ -1930,4 +1930,20 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	  edwin-command$mouse-toggle-pw-form
 	  edwin-command$toggle-pw-form
 	  edwin-command$view-password-file
-	  edwin-mode$password-view))
\ No newline at end of file
+	  edwin-mode$password-view))
+
+(define-package (edwin debian-changelog)
+  (files "debian-changelog")
+  (parent (edwin))
+  (export (edwin)
+	  edwin-command$debian-changelog-add-entry
+	  edwin-command$debian-changelog-add-version
+	  edwin-command$debian-changelog-distribution
+	  edwin-command$debian-changelog-finalize-and-save
+	  edwin-command$debian-changelog-finalize-last-version
+	  edwin-command$debian-changelog-unfinalize-last-version
+	  edwin-command$debian-changelog-urgency
+	  edwin-mode$debian-changelog
+	  edwin-variable$add-log-full-name
+	  edwin-variable$add-log-mailing-address
+	  edwin-variable$debian-changelog-mode-hook))
\ No newline at end of file
diff --git a/v7/src/edwin/loadef.scm b/v7/src/edwin/loadef.scm
index 6cd323d50..f9e5ab81e 100644
--- a/v7/src/edwin/loadef.scm
+++ b/v7/src/edwin/loadef.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: loadef.scm,v 1.42 2000/02/29 03:59:26 cph Exp $
+;;; $Id: loadef.scm,v 1.43 2001/02/05 18:55:56 cph Exp $
 ;;;
-;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -22,7 +22,8 @@
 
 (declare (usual-integrations))
 
-;;;; Major Mode Libraries
+;;; ****************
+
 (define-library 'TECHINFO-MODE
   '("techinfo" (EDWIN)))
 
@@ -32,6 +33,8 @@
 (define-autoload-command 'techinfo 'TECHINFO-MODE
   "Enter TechInfo mode.")
 
+;;; ****************
+
 (define-library 'TELNET-MODE
   '("telnet" (EDWIN)))
 
@@ -45,6 +48,8 @@
   "An event distributor that is invoked when entering Telnet mode."
   (make-event-distributor))
 
+;;; ****************
+
 (define-library 'MIDAS-MODE
   '("midas" (EDWIN)))
 
@@ -62,6 +67,8 @@
   "An event distributor that is invoked when entering Midas mode."
   (make-event-distributor))
 
+;;; ****************
+
 (define-library 'PASCAL-MODE
   '("pasmod" (EDWIN)))
 
@@ -88,23 +95,13 @@
 This must be a regular expression, or #F to disable the option."
   false)
 
+;;; ****************
+
 (define-library 'TEXINFO-MODE
   '("tximod" (EDWIN)))
 
 (define-autoload-major-mode 'texinfo 'text "Texinfo" 'TEXINFO-MODE
-  "Major mode for editing Texinfo files.
-
-  These are files that are used as input for TeX to make printed manuals
-and also to be turned into Info files by \\[texinfo-format-buffer] or
-`makeinfo'.  These files must be written in a very restricted and
-modified version of TeX input format.
-
-  Editing commands are like text-mode except that the syntax table is
-set up so expression commands skip Texinfo bracket groups.
-
-  In addition, Texinfo mode provides commands that insert various
-frequently used @-sign commands into the buffer.  You can use these
-commands to save keystrokes.")
+  "Major mode for editing Texinfo files.")
 
 (define-autoload-command 'texinfo-mode 'TEXINFO-MODE
   "Make the current mode be Texinfo mode.")
@@ -116,8 +113,8 @@ commands to save keystrokes.")
 (define-variable texinfo-mode-hook
   "An event distributor that is invoked when entering Texinfo mode."
   (make-event-distributor))
-
-;;;; Other Libraries
+
+;;; ****************
 
 (define-library 'manual
   '("manual" (EDWIN)))
@@ -141,6 +138,8 @@ Section (if any) and topic strings are appended (with space separators)
 and the resulting string is provided to a shell running in a subprocess."
   false
   string-or-false?)
+
+;;; ****************
 
 (define-library 'print
   '("print" (EDWIN)))
@@ -184,7 +183,9 @@ variable's value is #F, the text is printed using LPR-COMMAND."
 
 (define-autoload-command 'print-region 'PRINT
   "Print region contents as with Unix command `lpr -p'.")
-
+
+;;; ****************
+
 (define-library 'SORT
   '("sort" (EDWIN)))
 
@@ -205,6 +206,8 @@ variable's value is #F, the text is printed using LPR-COMMAND."
 
 (define-autoload-command 'sort-columns 'SORT
   "Sort lines by the text in a range of columns.")
+
+;;; ****************
 
 (define-library 'STEPPER
   '("eystep" (EDWIN STEPPER)))
@@ -218,6 +221,8 @@ variable's value is #F, the text is printed using LPR-COMMAND."
 (define-autoload-command 'step-defun 'STEPPER
   "Single-step the definition that the point is in or before.")
 
+;;; ****************
+
 (define-library 'NEWS-READER
   '("nntp" (EDWIN NNTP))
   '("snr" (EDWIN NEWS-READER)))
@@ -228,7 +233,9 @@ Normally uses the server specified by the variable news-server,
 but with a prefix arg prompts for the server name.
 Only one News reader may be open per server; if a previous News reader
 is open the that server, its buffer is selected.")
-
+
+;;; ****************
+
 (define-library 'VERILOG-MODE
   '("verilog" (EDWIN VERILOG)))
 
@@ -255,6 +262,8 @@ is open the that server, its buffer is selected.")
   "Extra indent for continuation lines of structure headers."
   4
   exact-nonnegative-integer?)
+
+;;; ****************
 
 (define-library 'VHDL-MODE
   '("vhdl" (EDWIN VHDL)))
@@ -282,22 +291,14 @@ is open the that server, its buffer is selected.")
   "Extra indent for lines not starting new statements."
   2
   exact-nonnegative-integer?)
-
-;;;; Webster
+
+;;; ****************
 
 (define-library 'WEBSTER
   '("webster" (EDWIN)))
 
 (define-autoload-major-mode 'webster 'read-only "Webster" 'WEBSTER
-  "Major mode for interacting with webster server.
-Commands:
-
-\\[webster-define]	look up the definition of a word
-\\[webster-spellings]	look up possible correct spellings for a word
-\\[webster-define]	look up possible endings for a word
-\\[webster-quit]	close connection to the Webster server
-
-Use webster-mode-hook for customization.")
+  "Major mode for interacting with webster server.")
 
 (define-autoload-command 'webster 'WEBSTER
   "Look up a word in Webster's dictionary.")
@@ -331,7 +332,7 @@ This is usually 103 or 2627."
   "*webster*"
   string?)
 
-;;;; Password Editor
+;;; ****************
 
 (define-library 'PASSWORD-EDIT
   '("pwedit" (EDWIN PASSWORD-EDIT))
@@ -361,6 +362,27 @@ See \\[view-password-file]."
 
 (define-autoload-command 'mouse-toggle-pw-form 'PASSWORD-EDIT
   "Toggle the body of the password form under mouse.")
+
+;;; ****************
+
+(define-library 'DEBIAN-CHANGELOG
+  '("debian-changelog" (EDWIN DEBIAN-CHANGELOG)))
+
+(define-autoload-major-mode 'debian-changelog 'text "Debian changelog"
+  'DEBIAN-CHANGELOG
+  "Major mode for editing Debian-style change logs.")
+
+(define-variable add-log-full-name
+  "Full name of user, for inclusion in ChangeLog headers.
+This defaults to the value `mail-full-name'."
+  #f
+  string-or-false?)
+
+(define-variable add-log-mailing-address
+  "Electronic mail address of user, for inclusion in ChangeLog headers.
+This defaults to the value of `user-mail-address'."
+  #f
+  string-or-false?)
 
 ;;;; DOS-specific commands