key (clj)

(deftest division
  (is (= clojure.core// /))
  (binding [*ns* *ns*]
    (eval '(do (ns foo
                 (:require [clojure.core :as bar])
                 (:use [clojure.test]))
               (is (= clojure.core// bar//))))))

(deftest preserve-read-cond-test
  (let [x (read-string {:read-cond :preserve} "#?(:clj foo :cljs bar)" )]
       (is (reader-conditional? x))
       (is (not (:splicing? x)))
       (is (= :foo (get x :no-such-key :foo)))
       (is (= (:form x) '(:clj foo :cljs bar)))
       (is (= x (reader-conditional '(:clj foo :cljs bar) false))))
  (let [x (read-string {:read-cond :preserve} "#?@(:clj [foo])" )]
       (is (reader-conditional? x))
       (is (:splicing? x))
       (is (= :foo (get x :no-such-key :foo)))
       (is (= (:form x) '(:clj [foo])))
       (is (= x (reader-conditional '(:clj [foo]) true))))
  (is (thrown-with-msg? RuntimeException #"No reader function for tag"
                        (read-string {:read-cond :preserve} "#js {:x 1 :y 2}" )))
  (let [x (read-string {:read-cond :preserve} "#?(:cljs #js {:x 1 :y 2})")
        [platform tl] (:form x)]
       (is (reader-conditional? x))
       (is (tagged-literal? tl))
       (is (= 'js (:tag tl)))
       (is (= {:x 1 :y 2} (:form tl)))
       (is (= :foo (get tl :no-such-key :foo)))
       (is (= tl (tagged-literal 'js {:x 1 :y 2}))))
  (testing "print form roundtrips"
           (doseq [s ["#?(:clj foo :cljs bar)"
                      "#?(:cljs #js {:x 1, :y 2})"
                      "#?(:clj #clojure.test_clojure.reader.TestRecord [42 85])"]]
                  (is (= s (pr-str (read-string {:read-cond :preserve} s)))))))

(deftest reader-conditionals
  (testing "basic read-cond"
    (is (= '[foo-form]
           (read-string {:read-cond :allow :features #{:foo}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[bar-form]
           (read-string {:read-cond :allow :features #{:bar}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[foo-form]
           (read-string {:read-cond :allow :features #{:foo :bar}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[]
           (read-string {:read-cond :allow :features #{:baz}} "[#?( :foo foo-form :bar bar-form)]"))))
  (testing "environmental features"
    (is (= "clojure" #?(:clj "clojure" :cljs "clojurescript" :default "default"))))
  (testing "default features"
    (is (= "default" #?(:clj-clr "clr" :cljs "cljs" :default "default"))))
  (testing "splicing"
    (is (= [] [#?@(:clj [])]))
    (is (= [:a] [#?@(:clj [:a])]))
    (is (= [:a :b] [#?@(:clj [:a :b])]))
    (is (= [:a :b :c] [#?@(:clj [:a :b :c])]))
    (is (= [:a :b :c] [#?@(:clj [:a :b :c])])))
  (testing "nested splicing"
    (is (= [:a :b :c :d :e]
           [#?@(:clj [:a #?@(:clj [:b #?@(:clj [:c]) :d]):e])]))
    (is (= '(+ 1 (+ 2 3))
           '(+ #?@(:clj [1 (+ #?@(:clj [2 3]))]))))
    (is (= '(+ (+ 2 3) 1)
           '(+ #?@(:clj [(+ #?@(:clj [2 3])) 1]))))
    (is (= [:a [:b [:c] :d] :e]
           [#?@(:clj [:a [#?@(:clj [:b #?@(:clj [[:c]]) :d])] :e])])))
  (testing "bypass unknown tagged literals"
    (is (= [1 2 3] #?(:cljs #js [1 2 3] :clj [1 2 3])))
    (is (= :clojure #?(:foo #some.nonexistent.Record {:x 1} :clj :clojure))))
  (testing "error cases"
    (is (thrown-with-msg? RuntimeException #"Feature should be a keyword" (read-string {:read-cond :allow} "#?((+ 1 2) :a)")))
    (is (thrown-with-msg? RuntimeException #"even number of forms" (read-string {:read-cond :allow} "#?(:cljs :a :clj)")))
    (is (thrown-with-msg? RuntimeException #"read-cond-splicing must implement" (read-string {:read-cond :allow} "#?@(:clj :a)")))
    (is (thrown-with-msg? RuntimeException #"is reserved" (read-string {:read-cond :allow} "#?@(:foo :a :else :b)")))
    (is (thrown-with-msg? RuntimeException #"must be a list" (read-string {:read-cond :allow} "#?[:foo :a :else :b]")))
    (is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string {:read-cond :BOGUS} "#?[:clj :a :default nil]")))
    (is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string "#?[:clj :a :default nil]")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1 2])")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1])")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj []) 1"))))
  (testing "clj-1698-regression"
    (let [opts {:features #{:clj} :read-cond :allow}]
      (is (= 1 (read-string opts "#?(:cljs {'a 1 'b 2} :clj 1)")))
      (is (= 1 (read-string opts "#?(:cljs (let [{{b :b} :a {d :d} :c} {}]) :clj 1)")))
      (is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj  ^{:a :b} {}))")))
      (is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj ^{:a :b} {}))")))
      (is (= 1 (read-string opts "#?(:cljs {:a #_:b :c} :clj 1)")))))
  (testing "nil expressions"
    (is (nil? #?(:default nil)))
    (is (nil? #?(:foo :bar :clj nil)))
    (is (nil? #?(:clj nil :foo :bar)))
    (is (nil? #?(:foo :bar :default nil)))))

(deftest namespaced-map-errors
  (are [err msg form] (thrown-with-msg? err msg (read-string form))
                      Exception #"Invalid token" "#:::"
                      Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}"
                      Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}"
                      Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}"
                      Exception #"Namespaced map must specify a namespace" "#: s{:a 1}"
                      Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}"
                      Exception #"Duplicate key: user/a" "#::{a 1 a 2}"))

(deftest t-Explicit-line-column-numbers
  (is (= {:line 42 :column 99}
         (-> "^{:line 42 :column 99} (1 2)" read-string meta (select-keys [:line :column]))))

  (are [l c s] (= {:line l :column c} (-> s str->lnpr read meta (select-keys [:line :column])))
    42 99 "^{:line 42 :column 99} (1 2)"
    1 99 "^{:column 99} (1 2)")

  (eval (-> "^{:line 42 :column 99} (defn explicit-line-numbering [])" str->lnpr read))
  (is (= {:line 42 :column 99}
         (-> 'explicit-line-numbering resolve meta (select-keys [:line :column])))))

(ns shadow.remote.runtime.cljs.js-builtins
  (:require
    [goog.object :as gobj]
    [clojure.core.protocols :as p]))

(extend-protocol p/Datafiable
  ;; FIXME: this is kind of a bad idea
  ;; can't do this for all objects, since none of the CLJS types implement this
  ;; protocol either. the protocol dispatch will end up using object
  ;; FIXME: this could detect CLJS types to some extent
  ;; or should it just implement the protocols for the types?
  object
  (datafy [o]
    (if-not (identical? (.-__proto__ o) js/Object.prototype)
      o
      (with-meta
        (->> (gobj/getKeys o)
             (reduce
               (fn [m key]
                 (assoc! m key (gobj/get o key)))
               (transient {}))
             (persistent!))

;; Clojure 1.6.0 with the :require below causes clojure.core/load-lib
;; to be called with the arguments: prefix=nil, lib=eastwood.util,
;; options=(:as :require true). When it tries to call (apply hash-map
;; option) with an odd number of arguments, it throws the exception:

;; IllegalArgumentException No value supplied for key: true


;; Even though the doc string for require says that it only takes the
;; option keys :as and :refer, it appears that it might also do
;; something reasonable for the use-documented option keys of :rename
;; and :exclude

;; Eastwood has been programmed not to warn about :exlude or :rename
;; option keys to a :require libspec, but only if it uses the :refer
;; option key.

(ns s3-examples
  (:require [clojure.core.async :as a]
            [clojure.spec.alpha :as s]
            [clojure.spec.gen.alpha :as gen]
            [clojure.java.io :as io]
            [clojure.repl :as repl]
            [cognitect.aws.client.api :as aws]))

  ;; what can it do?
  (aws/ops s3)
  ;; op names
  (-> (aws/ops s3) keys sort)

  ;; specs
  (aws/request-spec-key s3 :CreateBucket)
  (s/describe (aws/request-spec-key s3 :CreateBucket))
  (gen/sample (s/gen (aws/request-spec-key s3 :CreateBucket)))

  (aws/response-spec-key s3 :CreateBucket)
  (s/describe (aws/response-spec-key s3 :CreateBucket))
  (gen/sample (s/gen (aws/response-spec-key s3 :CreateBucket)))

(ns dynamodb-examples
  (:require [clojure.core.async :as a]
            [clojure.java.io :as io]
            [clojure.data.json :as json]
            [cognitect.aws.client.api :as aws]))

  (let [ ;; The aws-supplied example data are all json. We can use them
        ;; as/is, but we need keys defined the input specs to be
        ;; keywords if we want to validate the structure first!
        xform-specified-keys
        (fn [k]
          (get (reduce (fn [a v] (assoc a v (keyword v)))
                       {}
                       ["B" "BOOL" "BS" "Item" "L" "M" "N" "NS" "NULL" "PutRequest" "S" "SS"])
               k
               k))]
    (->> ["Forum.json"
          "Reply.json"
          "Thread.json"]
         (map #(-> (io/file "examples" "resources" "dynamodb" %)
                   slurp
                   (json/read-str :key-fn xform-specified-keys)))
         (map #(aws/invoke ddb {:op      :BatchWriteItem
                                :request {:RequestItems %}}))))

(ns deuce.emacs
  (:require [clojure.core :as c]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.globals :as globals])
  (:refer-clojure :only [])
  (:use [deuce.emacs-lisp :only [and apply-partially catch cond condition-case defconst define-compiler-macro defmacro
                                 defun defvar function if interactive lambda let let* or prog1 prog2 progn quote
                                 save-current-buffer save-excursion save-restriction setq setq-default
                                 unwind-protect while throw]]
        [deuce.emacs.alloc]
        [deuce.emacs.buffer]
        [deuce.emacs.bytecode]
        [deuce.emacs.callint]
        [deuce.emacs.callproc]
        [deuce.emacs.casefiddle]
        [deuce.emacs.casetab]
        [deuce.emacs.category]
        [deuce.emacs.ccl]
        [deuce.emacs.character]
        [deuce.emacs.charset]
        [deuce.emacs.chartab]
        [deuce.emacs.cmds]
        [deuce.emacs.coding]
        [deuce.emacs.composite]
        [deuce.emacs.data]
        [deuce.emacs.dired]
        [deuce.emacs.dispnew]
        [deuce.emacs.doc]
        [deuce.emacs.editfns]
        [deuce.emacs.emacs]
        [deuce.emacs.eval]
        [deuce.emacs.fileio]
        [deuce.emacs.filelock]
        [deuce.emacs.floatfns]
        [deuce.emacs.fns]
        [deuce.emacs.font]
        [deuce.emacs.frame]
        [deuce.emacs.indent]
        [deuce.emacs.insdel]
        [deuce.emacs.keyboard]
        [deuce.emacs.keymap]
        [deuce.emacs.lread]
        [deuce.emacs.macros]
        [deuce.emacs.marker]
        [deuce.emacs.menu]
        [deuce.emacs.minibuf]
        [deuce.emacs.print]
        [deuce.emacs.process]
        [deuce.emacs.search]
        [deuce.emacs.syntax]
        [deuce.emacs.term]
        [deuce.emacs.terminal]
        [deuce.emacs.textprop]
        [deuce.emacs.undo]
        [deuce.emacs.window]
        [deuce.emacs.xdisp]
        [deuce.emacs.xfaces]
        [deuce.emacs.xml]))

;; Stubs for running without MULE:
;; These keymaps are referenced from menu-bar.
(setq mule-menu-keymap (make-sparse-keymap))
(setq describe-language-environment-map (make-sparse-keymap))
(setq buffer-file-coding-system-explicit nil)
;; Used by startup/normal-top-level to set the locale, called with nil.
(defun set-locale-environment (&optional locale-name frame))
(setq current-language-environment "English")
;; Used by startup/fancy-about-text to find localized tutorial.
(defun get-language-info (lang-env key)
  (({"English" {'tutorial "TUTORIAL"}} lang-env {}) key))
;; Used by env.
(defun find-coding-systems-string (string))
;; These are used by the mode line
(setq current-input-method)
(defun coding-system-eol-type-mnemonic (coding-system)
  (symbol-value ({0 'eol-mnemonic-unix 1 'eol-mnemonic-dos 2 'eol-mnemonic-mac}
                 (coding-system-eol-type coding-system) 'eol-mnemonic-undecided)))

;; Keymap setup, should in theory be in deuce.emacs.keymap, but cannot for a reason I forgot.
(setq global-map (make-keymap))
(use-global-map (symbol-value 'global-map))

;; These use internal-define-key in Emacs, which doesn't define the prefix as symbol, unlike define-prefix-command.
(setq esc-map (make-keymap))
(fset 'ESC-prefix (symbol-value 'esc-map))
(setq ctl-x-map (make-keymap))
(fset 'Control-X-prefix (symbol-value 'ctl-x-map))

;; Main prefix keymaps setup from keymap.c
(define-key globals/global-map "\\e" 'ESC-prefix)
(define-key globals/global-map "\\C-x" 'Control-X-prefix)

;; self-insert-command for standard keys setup in cmds.c
(define-key globals/global-map "\\C-i" 'self-insert-command)
(c/doseq [n (c/range 32 (c/inc 127))]
         (define-key globals/global-map (make-string 1 n) 'self-insert-command))
(c/doseq [n (c/range 160 (c/inc 256))]
         (define-key globals/global-map (make-string 1 n) 'self-insert-command))

;; buffer commands from buffer.c
(define-key globals/ctl-x-map "b" 'switch-to-buffer)
(define-key globals/ctl-x-map "k" 'kill-buffer)

;; case commands from casefiddle.c
(define-key globals/ctl-x-map "\\C-u" 'upcase-region)
(put 'upcase-region 'disabled true)
(define-key globals/ctl-x-map "\\C-l" 'downcase-region)
(put 'downcase-region 'disabled true)

(define-key globals/esc-map "u" 'upcase-word)
(define-key globals/esc-map "l" 'downcase-word)
(define-key globals/esc-map "c" 'capitalize-word)

;; basic movement commands setup in cmds.c
(define-key globals/global-map "\\C-a" 'beginning-of-line)
(define-key globals/global-map "\\C-b" 'backward-char)
(define-key globals/global-map "\\C-e" 'end-of-line)
(define-key globals/global-map "\\C-f" 'forward-char)

;; basic commands setup in keyboard.c
(define-key globals/global-map "\\C-z" 'suspend-emacs)
(define-key globals/ctl-x-map "\\C-z" 'suspend-emacs)
(define-key globals/esc-map "\\C-c" 'exit-recursive-edit)
(define-key globals/global-map "\\C-]" 'abort-recursive-edit)
(define-key globals/esc-map "x" 'execute-extended-command)
;; There's also a bunch of initial_define_lispy_key I skip here

;; scolling commands in window.c
(define-key globals/ctl-x-map, "<" 'scroll-left)
(define-key globals/ctl-x-map ">" 'scroll-right)

(define-key globals/global-map "\\C-v" 'scroll-up-command)
(define-key globals/esc-map "\\C-v" 'scroll-other-window)
(define-key globals/esc-map "v" 'scroll-down-command)

;; var is definied in keyboard.clj
(setq function-key-map (make-sparse-keymap))
;; This map has a few low-level (like delete-frame) key defs in keybaoard.c
(setq special-event-map (make-sparse-keymap))
(setq local-function-key-map (make-sparse-keymap))
(set-keymap-parent globals/local-function-key-map globals/function-key-map)

(setq input-decode-map (make-sparse-keymap))
(setq key-translation-map (make-sparse-keymap))

(setq minibuffer-local-map (make-sparse-keymap))
(setq minibuffer-local-ns-map (make-sparse-keymap))
(set-keymap-parent globals/minibuffer-local-ns-map globals/minibuffer-local-map)