all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Xinglu Chen <public@yoctocell.xyz>
To: 51543@debbugs.gnu.org
Subject: [bug#51543] [PATCH 1/2] home: services: bash: Add ‘aliases’ field.
Date: Mon, 01 Nov 2021 10:45:32 +0100	[thread overview]
Message-ID: <231301123d2fe00e6c65e94ec45ffc906bf95ee1.1635759704.git.public@yoctocell.xyz> (raw)
In-Reply-To: <cover.1635759704.git.public@yoctocell.xyz>

* doc/guix.texi (Shells Home Services): Document it.
* gnu/home/services/shells.scm (bash-serialize-aliases): New procedure.
(home-bash-configuration, home-bash-extension): Add ‘aliases’ field.
(home-bash-extensions): Adjust accordingly.
* guix/scripts/home/import.scm (generate-bash-configuration+modules): Populate
the ‘alias’ field.
---
 doc/guix.texi                | 14 ++++++
 gnu/home/services/shells.scm | 85 ++++++++++++++++++++++++++----------
 guix/scripts/home/import.scm | 24 ++++++++++
 3 files changed, 100 insertions(+), 23 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ea1973f02c..f7312a5b30 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -36173,6 +36173,20 @@
 @item @code{environment-variables} (default: @code{()}) (type: alist)
 Association list of environment variables to set for the Bash session.
 
+@item @code{aliases} (default: @code{()}) (type: alist)
+Association list of aliases to set for the Bash session.  The alias will
+automatically be quoted, so something line this:
+
+@lisp
+'((\"ls\" . \"ls -alF\"))
+@end lisp
+
+turns into
+
+@example
+alias ls=\"ls -alF\"
+@end example
+
 @item @code{bash-profile} (default: @code{()}) (type: text-config)
 List of file-like objects, which will be added to @file{.bash_profile}.
 Used for executing user's commands at start of login shell (In most
diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm
index e2730967b2..bd1595a041 100644
--- a/gnu/home/services/shells.scm
+++ b/gnu/home/services/shells.scm
@@ -305,6 +305,18 @@ (define home-zsh-service-type
 ;;; Bash.
 ;;;
 
+(define (bash-serialize-aliases field-name val)
+  #~(string-append
+     #$@(map
+         (match-lambda
+           ((key . #f)
+            "")
+           ((key . #t)
+            #~(string-append "alias " #$key "\n"))
+           ((key . value)
+            #~(string-append "alias " #$key "=\"" #$value "\"\n")))
+         val)))
+
 (define-configuration home-bash-configuration
   (package
    (package bash)
@@ -317,6 +329,21 @@ (define-configuration home-bash-configuration
    (alist '())
    "Association list of environment variables to set for the Bash session."
    serialize-posix-env-vars)
+  (aliases
+   (alist '())
+   "Association list of aliases to set for the Bash session.  The alias will
+automatically be quoted, so something line this:
+
+@lisp
+'((\"ls\" . \"ls -alF\"))
+@end lisp
+
+turns into
+
+@example
+alias ls=\"ls -alF\"
+@end example"
+   bash-serialize-aliases)
   (bash-profile
    (text-config '())
    "List of file-like objects, which will be added to @file{.bash_profile}.
@@ -387,10 +414,11 @@ (define* (file-if-not-empty field #:optional (extra-content #f))
       (if (or extra-content
               (not (null? ((configuration-field-getter field-obj) config))))
           `(,(object->snake-case-string file-name)
-            ,(mixed-text-file
+            ,(apply mixed-text-file
               (object->snake-case-string file-name)
-              (if extra-content extra-content "")
-              (serialize-field field)))
+              (append
+               (if extra-content extra-content '())
+               (list (serialize-field field)))))
           '())))
 
   (filter
@@ -413,8 +441,9 @@ (define* (file-if-not-empty field #:optional (extra-content #f))
      ,@(list (file-if-not-empty
               'bashrc
               (if (home-bash-configuration-guix-defaults? config)
-                  guix-bashrc
-                  #f))
+                  (list guix-bashrc
+                        (serialize-field 'aliases))
+                  (list (serialize-field 'alises))))
              (file-if-not-empty 'bash-logout)))))
 
 (define (add-bash-packages config)
@@ -424,6 +453,9 @@ (define-configuration/no-serialization home-bash-extension
   (environment-variables
    (alist '())
    "Association list of environment variables to set.")
+  (aliases
+   (alist '())
+   "Association list of aliases to set.")
   (bash-profile
    (text-config '())
    "List of file-like objects.")
@@ -435,24 +467,31 @@ (define-configuration/no-serialization home-bash-extension
    "List of file-like objects."))
 
 (define (home-bash-extensions original-config extension-configs)
-  (home-bash-configuration
-   (inherit original-config)
-   (environment-variables
-    (append (home-bash-configuration-environment-variables original-config)
-            (append-map
-             home-bash-extension-environment-variables extension-configs)))
-   (bash-profile
-    (append (home-bash-configuration-bash-profile original-config)
-            (append-map
-             home-bash-extension-bash-profile extension-configs)))
-   (bashrc
-    (append (home-bash-configuration-bashrc original-config)
-            (append-map
-             home-bash-extension-bashrc extension-configs)))
-   (bash-logout
-    (append (home-bash-configuration-bash-logout original-config)
-            (append-map
-             home-bash-extension-bash-logout extension-configs)))))
+  (match original-config
+    (($ <home-bash-configuration> _ _ _ environment-variables aliases
+                                  bash-profile bashrc bash-logout)
+     (home-bash-configuration
+      (inherit original-config)
+      (environment-variables
+       (append environment-variables
+               (append-map
+                home-bash-extension-environment-variables extension-configs)))
+      (aliases
+       (append aliases
+               (append-map
+                home-bash-extension-aliases extension-configs)))
+      (bash-profile
+       (append bash-profile
+               (append-map
+                home-bash-extension-bash-profile extension-configs)))
+      (bashrc
+       (append bashrc
+               (append-map
+                home-bash-extension-bashrc extension-configs)))
+      (bash-logout
+       (append bash-logout
+               (append-map
+                home-bash-extension-bash-logout extension-configs)))))))
 
 (define home-bash-service-type
   (service-type (name 'home-bash)
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index 7a7712dd96..68420ff7f9 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -27,6 +27,9 @@ (define-module (guix scripts home import)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 popen)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (import-manifest
@@ -56,11 +59,32 @@ (define (generate-bash-configuration+modules destination-directory)
   (define (destination-append path)
     (string-append destination-directory "/" path))
 
+  (define (bash-alias->pair line)
+    (if (string-prefix? "alias" (pk line))
+        (let ((matched (string-match "alias (.+)=\"?'?([^\"']+)\"?'?" line)))
+          `(,(match:substring matched 1) . ,(match:substring matched 2)))
+        '()))
+  
+  (define (parse-aliases input)
+    (let loop ((line (read-line input))
+               (result '()))
+      (if (eof-object? line)
+          (reverse result)
+          (loop (read-line input)
+                (cons (bash-alias->pair line) result)))))
+
   (let ((rc (destination-append ".bashrc"))
         (profile (destination-append ".bash_profile"))
         (logout (destination-append ".bash_logout")))
     `((service home-bash-service-type
                (home-bash-configuration
+                ,@(if (file-exists? rc)
+                      `((aliases
+                         ',(let* ((port (open-pipe* OPEN_READ "bash" "-i" "-c" "alias"))
+                               (alist (parse-aliases port)))
+                           (close-port port)
+                           (filter (negate null?) alist))))
+                      '())
                 ,@(if (file-exists? rc)
                       `((bashrc
                          (list (local-file ,rc
-- 
2.33.0







  reply	other threads:[~2021-11-01  9:46 UTC|newest]

Thread overview: 18+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-11-01  9:43 [bug#51543] [PATCH 0/2] Some improvements to the Bash home service Xinglu Chen
2021-11-01  9:45 ` Xinglu Chen [this message]
2021-11-01  9:45 ` [bug#51543] [PATCH 2/2] doc: Document ‘home-bash-extension’ configuration record Xinglu Chen
2021-11-01 10:45   ` Liliana Marie Prikler
2021-11-01 13:22     ` Xinglu Chen
2021-11-01 16:38       ` Liliana Marie Prikler
2021-11-05 11:56         ` Xinglu Chen
2021-11-05 14:03 ` [bug#51543] [PATCH 0/2] Some improvements to the Bash home service Xinglu Chen
2021-11-05 14:03   ` [bug#51543] [PATCH 1/2] home: services: bash: Add ‘aliases’ field Xinglu Chen
2021-11-05 14:03   ` [bug#51543] [PATCH 2/2] doc: Improve documentation of the Bash home service Xinglu Chen
2021-11-05 19:36     ` Liliana Marie Prikler
2021-11-07 11:20       ` Xinglu Chen
2021-11-07 11:36   ` [bug#51543] [PATCH v3 0/2] Some improvements to " Xinglu Chen
2021-11-07 11:36     ` [bug#51543] [PATCH v3 1/2] home: services: bash: Add ‘aliases’ field Xinglu Chen
2021-11-07 11:36     ` [bug#51543] [PATCH v3 2/2] doc: Improve documentation of the Bash home service Xinglu Chen
2021-11-07 20:18       ` Liliana Marie Prikler
2021-11-07 20:58     ` bug#51543: [PATCH 0/2] Some improvements to " Ludovic Courtès
2021-11-13 20:35     ` [bug#51543] " Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=231301123d2fe00e6c65e94ec45ffc906bf95ee1.1635759704.git.public@yoctocell.xyz \
    --to=public@yoctocell.xyz \
    --cc=51543@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.