From ef4a2d9e37b9c63bd4f9f4110ed00069b9a04657 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 5 Feb 2001 18:55:56 +0000 Subject: [PATCH] New code to do Debian changelogs. --- v7/src/edwin/debian-changelog.scm | 264 ++++++++++++++++++++++++++++++ v7/src/edwin/decls.scm | 5 +- v7/src/edwin/ed-ffi.scm | 6 +- v7/src/edwin/edwin.pkg | 20 ++- v7/src/edwin/loadef.scm | 86 ++++++---- 5 files changed, 343 insertions(+), 38 deletions(-) create mode 100644 v7/src/edwin/debian-changelog.scm 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 -- 2.25.1