104 lines
3.6 KiB
Scheme
104 lines
3.6 KiB
Scheme
;;; Gash -- Guile As SHell
|
|
;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
|
|
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
|
;;;
|
|
;;; This file is part of Gash.
|
|
;;;
|
|
;;; Gash 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.
|
|
;;;
|
|
;;; Gash 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 Gash. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (gash built-ins set)
|
|
#:use-module (gash compat)
|
|
#:use-module (gash environment)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module (ice-9 match))
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; The 'set' utility.
|
|
;;;
|
|
;;; Code:
|
|
|
|
(define (option? o)
|
|
(memq o *option-names*))
|
|
|
|
(define (option-letter? chr)
|
|
(assoc chr *option-letters*))
|
|
|
|
(define (set-option! option value args)
|
|
(setopt! option value)
|
|
(unless (null? args)
|
|
(set-program-arguments (cons (car (program-arguments)) args))))
|
|
|
|
(define (main . args)
|
|
(match args
|
|
(("-o")
|
|
(for-each (lambda (option)
|
|
(format #t "~a\t~a~%"
|
|
option (getopt option)))
|
|
*option-names*)
|
|
EXIT_SUCCESS)
|
|
(("+o")
|
|
(for-each (lambda (option)
|
|
(format #t "set ~a ~a~%"
|
|
(if (getopt option) "-o" "+o") option))
|
|
*option-names*)
|
|
EXIT_SUCCESS)
|
|
(_ (let loop ((args args))
|
|
(match args
|
|
(() EXIT_SUCCESS)
|
|
(("--" . args)
|
|
(set-program-arguments (cons (car (program-arguments)) args))
|
|
EXIT_SUCCESS)
|
|
(("-o" option-string . args)
|
|
(let ((option (string->symbol option-string)))
|
|
(match option
|
|
((? option?)
|
|
(setopt! option #t)
|
|
(loop args))
|
|
(_ (format (current-error-port)
|
|
"~a: set: invalid option ~a~%"
|
|
(car (program-arguments)) option)
|
|
EXIT_FAILURE))))
|
|
(("+o" option-string . args)
|
|
(let ((option (string->symbol option-string)))
|
|
(match option
|
|
((? option?)
|
|
(setopt! option #f)
|
|
(loop args))
|
|
(_ (format (current-error-port)
|
|
"~a: set: invalid option ~a~%"
|
|
(car (program-arguments)) option)
|
|
EXIT_FAILURE))))
|
|
((op . args)
|
|
(match (string->list op)
|
|
((#\- (? option-letter? chr) ...)
|
|
(for-each (cut setopt! <> #t)
|
|
(map (cut assoc-ref *option-letters* <>) chr))
|
|
EXIT_SUCCESS)
|
|
((#\+ (? option-letter? chr) ...)
|
|
(for-each (cut setopt! <> #f)
|
|
(map (cut assoc-ref *option-letters* <>) chr))
|
|
EXIT_SUCCESS)
|
|
((#\- (? option-letter? chr))
|
|
(setopt! (assoc-ref *option-letters* chr) #t)
|
|
(loop args))
|
|
((#\+ (? option-letter? chr))
|
|
(setopt! (assoc-ref *option-letters* chr) #f)
|
|
(loop args))
|
|
(_ (loop (cons* "--" op args)))))
|
|
(_ (format (current-error-port)
|
|
"~a: set: invalid options ~s~%"
|
|
(car (program-arguments)) args)
|
|
EXIT_FAILURE))))))
|