aboutsummaryrefslogtreecommitdiff
path: root/etc/indent-code.el.in
blob: 6102b5d1ab7baaaea2824fdf114c2831480d559c (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
#!@EMACS@ --script
;;; indent-code.el --- Run Emacs to indent a package definition.

;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>

;; This file is part of GNU Guix.

;; GNU Guix 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.

;; GNU Guix 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 scripts indents the given file or package definition in the specified
;; file using Emacs.

;;; Code:

;; Load Scheme indentation rules from ".dir-locals.el".
(with-temp-buffer
  (scheme-mode)
  (let ((default-directory (file-name-as-directory load-file-name))
        (enable-local-variables :all))
    (hack-dir-local-variables)
    (hack-local-variables-apply)))

;; Add indentation info for Scheme constructs that are not Guix-specific.
;; This is normally provided by Geiser but this file is for people who may not
;; be running Geiser, so we just copy it here (from 'geiser-syntax.el').
(defmacro guix-syntax--scheme-indent (&rest pairs)
  `(progn ,@(mapcar (lambda (p)
                      `(put ',(car p) 'scheme-indent-function ',(cadr p)))
                    pairs)))

(guix-syntax--scheme-indent
 (and-let* 1)
 (case-lambda 0)
 (catch defun)
 (class defun)
 (dynamic-wind 0)
 (guard 1)
 (let*-values 1)
 (let-values 1)
 (let/ec 1)
 (letrec* 1)
 (match 1)
 (match-lambda 0)
 (match-lambda* 0)
 (match-let scheme-let-indent)
 (match-let* 1)
 (match-letrec 1)
 (opt-lambda 1)
 (parameterize 1)
 (parameterize* 1)
 (receive 2)
 (require-extension 0)
 (syntax-case 2)
 (test-approximate 1)
 (test-assert 1)
 (test-eq 1)
 (test-equal 1)
 (test-eqv 1)
 (test-group-with-cleanup 1)
 (test-runner-on-bad-count! 1)
 (test-runner-on-bad-end-name! 1)
 (test-runner-on-final! 1)
 (test-runner-on-group-begin! 1)
 (test-runner-on-group-end! 1)
 (test-runner-on-test-begin! 1)
 (test-runner-on-test-end! 1)
 (test-with-runner 1)
 (unless 1)
 (when 1)
 (while 1)
 (with-exception-handler 1)
 (with-syntax 1))


(pcase command-line-args-left
  (`(,file-name ,package-name)
   ;; Indent the definition of PACKAGE-NAME in FILE-NAME.
   (find-file file-name)
   (goto-char (point-min))
   (if (re-search-forward (concat "^(define\\(-public\\) +"
                                  package-name)
                          nil t)
       (let ((indent-tabs-mode nil))
         (beginning-of-defun)
         (indent-sexp)
         (save-buffer)
         (message "Done!"))
     (error "Package '%s' not found in '%s'"
            package-name file-name)))
  (`(,file-name)
   ;; Indent all of FILE-NAME.
   (find-file file-name)
   (let ((indent-tabs-mode nil))
     (indent-region (point-min) (point-max))
     (save-buffer)
     (message "Done!")))
  (x
   (error "Usage: indent-code.el FILE [PACKAGE]")))

;;; indent-code.el ends here
8 #\\-~s #\\-~s " '(begin (let ((current (getenv "GUIX_FOO"))) (setenv "GUIX_FOO" (if current (string-append "/some/path:/some/other/path" ":" current) "/some/path:/some/other/path")))) `(let ((cl (command-line))) (apply execl "/anything/cabbage-bash-1.2.3/bin/python3" (car cl) (append '("-and" "-args") cl)))) script-contents) (call-with-temporary-directory (lambda (directory) (let ((script-file-name (string-append directory "/foo"))) (call-with-output-file script-file-name (lambda (port) (format port script-contents))) (chmod script-file-name #o777) (wrap-script script-file-name #:guile "MYGUILE" `("GUIX_FOO" prefix ("/some/path" "/some/other/path"))) (let ((str (call-with-input-file script-file-name get-string-all))) (with-directory-excursion directory (delete-file "foo")) str)))))) (test-assert "wrap-script, raises condition" (call-with-temporary-directory (lambda (directory) (let ((script-file-name (string-append directory "/foo"))) (call-with-output-file script-file-name (lambda (port) (format port "This is not a script"))) (chmod script-file-name #o777) (guard (c ((wrap-error? c) #t)) (wrap-script script-file-name #:guile "MYGUILE" `("GUIX_FOO" prefix ("/some/path" "/some/other/path"))) #f))))) (define (arg-test bash-args) (call-with-temporary-directory (lambda (directory) (let ((script-file-name (string-append directory "/bash-test.sh"))) (call-with-output-file script-file-name (lambda (port) (display (string-append "\ #!" (which "bash") bash-args " echo \"$#$0$*${A}\"") port))) (display "Unwrapped script contents:\n") (call-with-input-file script-file-name (lambda (port) (display (get-string-all port)))) (newline) (newline) (chmod script-file-name #o777) (setenv "A" "A") (let* ((run-script (lambda _ (open-pipe* OPEN_READ script-file-name "1" "2" "3 3" "4"))) (pipe (run-script)) (unwrapped-output (get-string-all pipe))) (close-pipe pipe) (wrap-script script-file-name `("A" = ("A\nA"))) (display "Wrapped script contents:\n") (call-with-input-file script-file-name (lambda (port) (display (get-string-all port)))) (newline) (newline) (let* ((pipe (run-script)) (wrapped-output (get-string-all pipe))) (close-pipe pipe) (display "./bash-test.sh 1 2 3\\ 3 4 # Output:\n") (display unwrapped-output) (newline) (display "./bash-test.sh 1 2 3\\ 3 4 # Output (wrapped):\n") (display wrapped-output) (newline) (string=? (string-append unwrapped-output "A\n") wrapped-output))))))) (test-assert "wrap-script, argument handling" (arg-test "")) (test-assert "wrap-script, argument handling, bash --norc" (arg-test " --norc")) (test-equal "substitute*, text contains a NUL byte, UTF-8" "c\0d" (with-fluids ((%default-port-encoding "UTF-8") (%default-port-conversion-strategy 'error)) ;; The GNU libc is locale sensitive. Depending on the value of LANG, the ;; test could fail with "string contains #\\nul character: ~S" or "cannot ;; convert wide string to output locale". (setlocale LC_ALL "en_US.UTF-8") (call-with-temporary-output-file (lambda (file port) (format port "a\0b") (flush-output-port port) (substitute* file (("a") "c") (("b") "d")) (with-input-from-file file (lambda _ (get-string-all (current-input-port)))))))) (test-equal "search-input-file: exception if not found" `((path) (file . "does-not-exist")) (guard (e ((search-error? e) `((path . ,(search-error-path e)) (file . ,(search-error-file e))))) (search-input-file '() "does-not-exist"))) (test-equal "search-input-file: can find if existent" (which "guile") (search-input-file `(("guile/bin" . ,(dirname (which "guile")))) "guile")) (test-equal "search-input-file: can search in multiple directories" (which "guile") (call-with-temporary-directory (lambda (directory) (search-input-file `(("irrelevant" . ,directory) ("guile/bin" . ,(dirname (which "guile")))) "guile")))) (test-end)