Initial commit.

3 files changed, 350 insertions, 0 deletions

diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..9f9d07c
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,73 @@
+;;; guix.scm --- Additional functions for Emacs Guix
+
+;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+
+;; Emacs-Guix-Misc 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 3 of the
+;; License, or (at your option) any later version.
+;;
+;; Emacs-Guix-Misc 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 Emacs-Redshift.
+;; If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains Guix package for development version of
+;; Emacs-Guix-Misc.  To build or install, run:
+;;
+;;   guix build --file=guix.scm
+;;   guix package --install-from-file=guix.scm
+
+;;; Code:
+
+(use-modules ((guix licenses) #:prefix license:)
+             (guix build utils)
+             (guix build-system emacs)
+             (guix gexp)
+             (guix git-download)
+             (guix packages)
+             (ice-9 popen)
+             (ice-9 rdelim))
+
+(define %source-dir (dirname (current-filename)))
+
+(define (git-output . args)
+  "Execute 'git ARGS ...' command and return its output without trailing
+newspace."
+  (with-directory-excursion %source-dir
+    (let* ((port   (apply open-pipe* OPEN_READ "git" args))
+           (output (read-string port)))
+      (close-port port)
+      (string-trim-right output #\newline))))
+
+(define (current-commit)
+  (git-output "log" "-n" "1" "--pretty=format:%H"))
+
+(let ((commit (current-commit)))
+  (package
+    (name "emacs-guix-misc")
+    (version (string-append "0.0.1" "-" (string-take commit 7)))
+    (source (local-file %source-dir
+                        #:recursive? #t
+                        #:select? (git-predicate %source-dir)))
+    (build-system emacs-build-system)
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'chdir-elisp
+           ;; Elisp directory is not in root of the source.
+           (lambda _
+             (chdir "lisp"))))))
+    (home-page "https://github.com/wigust/emacs-guix-misc")
+    (synopsis "Additional functions for Emacs Guix")
+    (description
+     "This package provides an additional functionality for Emacs Guix.")
+    (license license:gpl3+)))
+
+;;; guix.scm ends here
diff --git a/lisp/guix-ffap.el b/lisp/guix-ffap.el
new file mode 100644
index 0000000..7286562
--- /dev/null
+++ b/lisp/guix-ffap.el
@@ -0,0 +1,64 @@
+;;; emacs-guix-ffap.el --- Misc function for Emacs Guix  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018  Oleg Pykhalov
+
+;; Author: Oleg Pykhalov <go.wigust@gmail.com>
+;; Keywords: local
+
+;; 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 3 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 program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides additional functionality in addition to Emacs
+;; Guix.
+
+;;; Code:
+
+(defcustom guix-package-regexp
+  (rx (one-or-more (or alphanumeric "-" ".")))
+  "Regexp matching Guix store path."
+  :type 'regexp
+  :group 'guix)
+
+(defcustom guix-package-source-regexp
+  (concat guix-package-regexp (rx ".tar" (zero-or-more ".gz")))
+  "Regexp matching Guix package source path."
+  :type 'regexp
+  :group 'guix)
+
+(defcustom guix-store-path-regexp
+  (concat guix-store-directory "/" guix-hash-regexp
+          "-" guix-package-regexp (rx line-end))
+  "Regexp matching Guix store path."
+  :type 'regexp
+  :group 'guix)
+
+(defcustom guix-store-path-package-source-regexp
+  (concat guix-store-directory "/" guix-hash-regexp
+          "-" guix-package-source-regexp (rx line-end))
+  "Regexp matching Guix store path to package source."
+  :type 'regexp
+  :group 'guix)
+
+(defun guix-ffap-store-package-source-path-p (filename)
+  "If FILENAME matches `guix-store-path-regexp', return it."
+  (when (string-match-p guix-store-path-package-source-regexp filename)
+    filename))
+
+(defun guix-ffap-store-path-p (filename)
+  "If FILENAME matches `guix-store-path-regexp', return it."
+  (when (string-match-p guix-store-path-regexp filename) filename))
+
+(provide 'emacs-guix-ffap)
+;;; emacs-guix-ffap.el ends here
diff --git a/lisp/guix-merge-upstream.el b/lisp/guix-merge-upstream.el
new file mode 100644
index 0000000..df1f69b
--- /dev/null
+++ b/lisp/guix-merge-upstream.el
@@ -0,0 +1,213 @@
+;;; guix-merge-upstream.el --- Misc function for Emacs Guix  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018  Oleg Pykhalov
+
+;; Author: Oleg Pykhalov <go.wigust@gmail.com>
+;; Keywords: local
+
+;; 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 3 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 program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides additional functionality in addition to Emacs
+;; Guix.
+
+;;; Code:
+
+(defun guix-mu-next ()
+  (interactive)
+  (forward-sexp)
+  (forward-char 2))
+
+(defun guix-mu-prev ()
+  (interactive)
+  (backward-sexp))
+
+(defun guix-mu-other-next ()
+  (interactive)
+  (other-window 1)
+  (forward-sexp)
+  (forward-char 2)
+  (other-window 1))
+
+(defun guix-mu-other-prev ()
+  (interactive)
+  (other-window 1)
+  (backward-sexp)
+  (other-window 1))
+
+(defun guix-mu-kill-sexp ()
+  (interactive)
+  (kill-sexp)
+  (let ((point (point)))
+    (delete-region point (+ point 2))))
+
+(defun guix-mu-other ()
+  (interactive)
+  (other-window 1))
+
+(defun guix-mu-yank ()
+  (interactive)
+  (yank)
+  (newline 2)
+  (backward-sexp))
+
+(defun guix-mu-copy ()
+  (interactive)
+  (guix-mu-kill-sexp)
+  (other-window 1)
+  (guix-mu-yank)
+  (other-window 1))
+
+(defun guix-mu-commit ()
+  (interactive)
+  (save-buffer)
+  (let ((var (save-excursion
+               (forward-char)
+               (forward-sexp)
+               (forward-char)
+               (thing-at-point 'symbol)))
+        (filename (buffer-file-name)))
+    (call-interactively #'vc-next-action)
+    (call-interactively #'vc-next-action)
+    (insert "gnu: Add " var)
+    (newline 2)
+    (insert (format "* %s (%s): New public variable."
+                    (f-relative filename
+                                (f-expand (vc-git-root filename)))
+                    var))
+    (log-edit-done)))
+
+(defun guix-mu-copy-and-commit ()
+  (interactive)
+  (guix-mu-kill-sexp)
+  (other-window 1)
+  (guix-mu-yank)
+  (guix-mu-commit)
+  (other-window 1))
+
+(defun guix-mu-revert ()
+  (interactive)
+  (yes-or-no-p "Revert all changes ? ")
+  (revert-buffer nil t)
+  (other-window 1)
+  (revert-buffer nil t)
+  (other-window 1))
+
+(defun guix-mu-hide-all ()
+  (interactive)
+  (let ((hs-hide-all-non-comment-function nil))
+    (hs-hide-all)))
+
+(defun guix-mu-search (package)
+  "Search for a PACKAGE and return it."
+  (interactive)
+  (goto-char (point-min))
+  (search-forward (concat "(define-public " package))
+  (beginning-of-line)
+  package)
+
+(defun guix-mu-kill ()
+  "Kill sexp and delete blank lines."
+  (kill-sexp)
+  (delete-blank-lines))
+
+(defun guix-commit (package message comment)
+  "Commit a PACKAGE with MESSAGE and COMMENT."
+  (let* ((filename (buffer-file-name (current-buffer)))
+         (relative (f-relative filename
+                               (f-expand (vc-git-root filename)))))
+    (call-interactively #'vc-next-action)
+    (call-interactively #'vc-next-action)
+    (insert (format "%s: %s\n\n"
+                    (car (split-string relative "/")) message)
+            (format "* %s (%s): %s" relative package comment))
+    (call-interactively #'fill-paragraph)
+    (log-edit-done)))
+
+(defun guix-mu-foo ()
+  (interactive)
+  (let ((package (thing-at-point 'symbol)))
+    (beginning-of-line)
+    (kill-line 1)
+    (with-current-buffer (get-buffer "emacs.scm<wigust>")
+      (guix-mu-search package)
+      (guix-mu-kill)
+      (save-buffer)
+      (guix-commit package
+                   (format "Merge %s to Guix package collection."
+                           package)
+                   (format "Merge %s to Guix package collection."
+                           package)))
+    (with-current-buffer (get-buffer "emacs.scm<gnu>")
+      (goto-char (point-max))
+      (delete-blank-lines)
+      (insert "\n")
+      (yank)
+      (save-buffer)
+      (guix-commit package
+                   (format "Add %s." package)
+                   "New public variable."))
+    (switch-to-buffer (get-buffer "*shell guix*"))
+    (insert "env PAGER= git log --oneline --max-count=1")
+    (comint-send-input)
+    (insert "./pre-inst-env env GUIX_PACKAGE_PATH= guix build --no-grafts "
+            package)
+    (comint-send-input)))
+
+(defun guix-commit-fix-linter ()
+  (interactive)
+  (save-buffer)
+  (let ((var (save-excursion
+               (geiser-syntax--pop-to-top)
+               (forward-char)
+               (forward-sexp)
+               (forward-char)
+               (thing-at-point 'symbol)))
+        (filename (buffer-file-name)))
+    (call-interactively #'vc-next-action)
+    (call-interactively #'vc-next-action)
+    (insert "wigust: " var ": Fix linter warning.")
+    (call-interactively #'fill-paragraph)
+    (newline 2)
+    (insert (format "* %s (%s): Fix linter warning."
+                    (f-relative filename
+                                (f-expand (vc-git-root filename)))
+                    var))
+    (log-edit-done)))
+
+;; (local-set-key (kbd "<f5>") (lambda () (interactive) (guix-mu-foo)))
+;; (local-set-key (kbd "<f5>") (lambda () (interactive) (switch-to-buffer "*Shell Command Output*")))
+
+;; git -C /home/natsu/src/guix-wigust reset --hard HEAD~ && git reset --hard HEAD~
+
+;; (defhydra hydra-guix-mu () "merge upstream"
+;;   ("C" guix-mu-copy-and-commit "copy and commit")
+;;   ("N" guix-mu-other-next "other next")
+;;   ("P" guix-mu-other-prev "other prev")
+;;   ("Y" guix-mu-copy "copy")
+;;   ("c" guix-mu-commit "commit")
+;;   ("k" guix-mu-kill-sexp "kill-sexp")
+;;   ("n" guix-mu-next "next")
+;;   ("o" guix-mu-other "other")
+;;   ("p" guix-mu-prev "prev")
+;;   ("q" nil "quit")
+;;   ("r" guix-mu-revert "revert")
+;;   ("u" undo "undo")
+;;   ("y" guix-mu-yank "yank"))
+
+;; (global-set-key (kbd "<f5>") #'hydra-guix-mu/body)
+
+(provide 'guix-merge-upstream)
+;;; guix-merge-upstream.el ends here