emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

scratch/icons 4b7062e405 03/11: Factor out new function admin--read-root


From: Stefan Kangas
Subject: scratch/icons 4b7062e405 03/11: Factor out new function admin--read-root-directory
Date: Wed, 24 Aug 2022 02:40:43 -0400 (EDT)

branch: scratch/icons
commit 4b7062e40559c060b9686d87c1c88cac50e55057
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefankangas@gmail.com>

    Factor out new function admin--read-root-directory
    
    * admin/admin.el (admin--read-root-directory): Factor out...
    (add-release-logs, set-version, set-copyright)
    (make-manuals-dist): ...from here.
---
 admin/admin.el | 32 ++++++++++++++------------------
 1 file changed, 14 insertions(+), 18 deletions(-)

diff --git a/admin/admin.el b/admin/admin.el
index c84287a702..10e63b9c90 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -28,12 +28,18 @@
 
 (defvar add-log-time-format)           ; in add-log
 
+(defun admin--read-root-directory ()
+  "Prompt for an Emacs root directory."
+  (read-directory-name "Emacs root directory: "  source-directory nil t)
+  (unless (file-exists-p (expand-file-name "src/emacs.c" root))
+    (user-error "%s doesn't seem to be the root of an Emacs source tree" 
root)))
+
 (defun add-release-logs (root version &optional date)
   "Add \"Version VERSION released.\" change log entries in ROOT.
 Also update the etc/HISTORY file.
 Root must be the root of an Emacs source tree.
 Optional argument DATE is the release date, default today."
-  (interactive (list (read-directory-name "Emacs root directory: ")
+  (interactive (list (admin--read-root-directory)
                     (read-string "Version number: "
                                  (format "%s.%s" emacs-major-version
                                          emacs-minor-version))
@@ -41,8 +47,6 @@ Optional argument DATE is the release date, default today."
                                  (progn (require 'add-log)
                                          (funcall add-log-time-format nil 
t)))))
   (setq root (expand-file-name root))
-  (unless (file-exists-p (expand-file-name "src/emacs.c" root))
-    (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
   (let ((clog (expand-file-name "ChangeLog" root)))
     (if (file-exists-p clog)
         ;; Basic check that a ChangeLog that exists is not your personal one.
@@ -95,10 +99,8 @@ Optional argument DATE is the release date, default today."
   "Set Emacs version to VERSION in relevant files under ROOT.
 Root must be the root of an Emacs source tree."
   (interactive (list
-               (read-directory-name "Emacs root directory: " source-directory)
+                (admin--read-root-directory)
                (read-string "Version number: " emacs-version)))
-  (unless (file-exists-p (expand-file-name "src/emacs.c" root))
-    (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
   (unless admin-git-command
     (user-error "Could not find git; please install git and move NEWS 
manually"))
   (message "Setting version numbers...")
@@ -207,9 +209,9 @@ Documentation changes might not have been completed!"))))
         (dolist (s '("Installation Changes" "Startup Changes" "Changes"
                      "Editing Changes"
                      "Changes in Specialized Modes and Packages"
-                          "New Modes and Packages"
-                          "Incompatible Lisp Changes"
-                          "Lisp Changes"))
+                     "New Modes and Packages"
+                     "Incompatible Lisp Changes"
+                     "Lisp Changes"))
           (insert (format "\n\n* %s in Emacs %s\n" s newshort)))
         (insert (format "\n\n* Changes in Emacs %s on \
 Non-Free Operating Systems\n" newshort)))
@@ -224,13 +226,11 @@ Non-Free Operating Systems\n" newshort)))
   "Set Emacs short copyright to COPYRIGHT in relevant files under ROOT.
 Root must be the root of an Emacs source tree."
   (interactive (list
-                (read-directory-name "Emacs root directory: " nil nil t)
+                (admin--read-root-directory)
                 (read-string
                  "Short copyright string: "
                  (format "Copyright (C) %s Free Software Foundation, Inc."
                          (format-time-string "%Y")))))
-  (unless (file-exists-p (expand-file-name "src/emacs.c" root))
-    (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
   (message "Setting copyrights...")
   (set-version-in-file root "configure.ac" copyright
                       (rx (and bol "copyright" (0+ (not (in ?\")))
@@ -283,8 +283,7 @@ Optional argument TYPE is type of output (nil means all)."
                       (if noninteractive
                           (or (pop command-line-args-left)
                               default-directory)
-                        (read-directory-name "Emacs root directory: "
-                                             source-directory nil t))))
+                        (admin--read-root-directory))))
                 (list root
                       (if current-prefix-arg
                           (completing-read
@@ -768,15 +767,12 @@ Optional argument TYPE is type of output (nil means all)."
                       (if noninteractive
                           (or (pop command-line-args-left)
                               default-directory)
-                        (read-directory-name "Emacs root directory: "
-                                             source-directory nil t))))
+                        (admin--read-root-directory))))
                 (list root
                       (if current-prefix-arg
                           (completing-read
                            "Type: "
                            '("emacs" "lispref" "lispintro" "misc"))))))
-  (unless (file-exists-p (expand-file-name "src/emacs.c" root))
-    (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
   (dolist (m '("emacs" "lispref" "lispintro" "misc"))
     (if (member type (list nil m))
        (make-manuals-dist--1 root m))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]