deuce

0.1.0-SNAPSHOT


DEUCE - Deuce is (not yet) Emacs under Clojure

dependencies

org.clojure/clojure
1.7.0
com.googlecode.lanterna/lanterna
3.0.0-beta2
com.taoensso/timbre
4.3.1
org.tcrawley/dynapath
0.2.3
org.flatland/ordered
1.5.3
fipp
0.5.1



(this space intentionally left almost blank)
 
{el/vec deuce.emacs-lisp/vector-reader
 el/sym deuce.emacs-lisp/symbol-reader}
 
(ns deuce.main
  (:require [clojure.string :as s]
            [clojure.java.io :as io]
            [deuce.emacs]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.globals :as globals]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.fns :as fns]
            [deuce.emacs.keymap :as keymap]
            [deuce.emacs.keyboard :as keyboard]
            [deuce.emacs.lread :as lread]
            [deuce.emacs.terminal :as terminal]
            [deuce.emacs.window :as window]
            [deuce.emacs.xdisp :as xdisp]
            [taoensso.timbre :as timbre]
            [taoensso.timbre.appenders.core :as timbre-appenders]
            [dynapath.util :as dp])
  (:import [java.io FileNotFoundException InputStreamReader]
           [java.awt Toolkit]
           [java.awt.datatransfer DataFlavor StringSelection]
           [java.util HashSet]
           [clojure.lang ExceptionInfo]
           [deuce.emacs.data Buffer Window]
           [com.googlecode.lanterna TerminalPosition SGR]
           [com.googlecode.lanterna TextColor$ANSI]
           [com.googlecode.lanterna.graphics TextGraphics]
           [com.googlecode.lanterna.screen Screen])
  (:gen-class))

Start Deuce like this: make run-dev

This will put you in scratch, with the keyboard enabled. There's no minibuffer yet, so you have to switch buffer from the REPL. Several keyboard commands fail or are a bit off (like move-end-of-line).

Connect to nREPL from Emacs on port 7888: user> (in-ns 'deuce.emacs) ;; We're now in Emacs Lisp

Tail the log at ~/.deuce.d/deuce.log Errors are also visible in the Echo Area

(defn nrepl [port]
  (require 'clojure.tools.nrepl.server)
  (with-out-str
    ((resolve 'clojure.tools.nrepl.server/start-server)
     :port port
     :handler (try
                (require 'cider.nrepl)
                (resolve 'cider.nrepl/cider-nrepl-handler)
                (catch Exception _
                  (resolve 'clojure.tools.nrepl.server/default-handler)))))
  (println "nrepl server listening on" port))

The way this does this is probably utterly wrong, written by data inspection, not reading Emacs source. But produces the expected result:

(defn render-menu-bar []
  (when (data/symbol-value 'menu-bar-mode)
    (let [map-for-mode #(let [map (symbol (str % "-map"))]
                          (when (data/boundp map)
                            (data/symbol-value map)))
          ;; The consp check here is suspicious.
          ;; There's a "menu-bar" string in there which probably shouldn't be.
          menus-for-map #(map keymap/keymap-prompt (filter data/consp (fns/nthcdr 2 (fns/assq 'menu-bar %))))
          menu-bar-by-name #(data/symbol-value (symbol (str "menu-bar-" %)))
          final-items (map menu-bar-by-name (data/symbol-value 'menu-bar-final-items))
          final-menus (map keymap/keymap-prompt final-items)
          ;; Hack to create the same display order as Emacs.
          menu-bar (concat (remove (some-fn nil? symbol?) ;; This is to get rid of tmm-menu-bar-mouse
                                   (remove (set final-menus) ;; Remove Help that goes on the end.
                                           (mapcat menus-for-map [(keymap/current-global-map)
                                                                  (keymap/current-local-map)])))
                           final-menus)]
      (s/join " " menu-bar))))

Renders a single window using Lanterna. Scrolling is not properly taken care of. Hard to bootstrap, requires fiddling when connected to nREPL inside Deuce atm. Consider moving all this into deuce.emacs.dispnew

(declare ^Screen screen)
(declare ^TextGraphics text-graphics)
(def reverse-video {:styles #{SGR/REVERSE}})
(def region-colors {:fg TextColor$ANSI/DEFAULT :bg TextColor$ANSI/YELLOW})
(defn puts
  ([x y s] (puts x y s {}))
  ([x y s {:keys [styles fg bg] :or {styles #{} fg TextColor$ANSI/DEFAULT bg TextColor$ANSI/DEFAULT}}]
   (.setForegroundColor text-graphics fg)
   (.setBackgroundColor text-graphics bg)
   (.putString text-graphics x y (str s) (HashSet. styles))))
(defn pad [s cols]
  (format (str "%-" cols "s") s))

If the screen gets messed up by other output like a stack trace you need to call this.

(defn blank []
  (.clear screen)
  (.clearScreen (.getTerminal screen))
  (.refresh screen))
(doseq [f '[line-indexes pos-to-line point-coords]]
  (eval `(def ~f (ns-resolve 'deuce.emacs.cmds '~f))))
(defn render-live-window [^Window window]
  (let [^Buffer buffer (window/window-buffer window)
        minibuffer? (window/window-minibuffer-p window)
        [header-line mode-line] (when-not minibuffer?
                                  [(buffer/buffer-local-value 'header-line-format buffer)
                                   (buffer/buffer-local-value 'mode-line-format buffer)])
        text (binding [buffer/*current-buffer* buffer]
               (editfns/buffer-string))
        line-indexes (line-indexes text)
        pos-to-line (partial pos-to-line line-indexes)
        point-coords (partial point-coords line-indexes)
        pt (- @(.pt buffer) (or @(.begv buffer) 0))
        line (pos-to-line pt)
        total-lines (- @(.total-lines window) (or (count (remove nil? [header-line mode-line])) 0))
        scroll (max (inc (- line total-lines)) 0)
        mark-active? (buffer/buffer-local-value 'mark-active buffer)
        selected-window? (= window (window/selected-window))]
    (let [lines (s/split text #"\n")
          cols @(.total-cols window)
          top-line @(.top-line window)
          top-line (if header-line (inc top-line) top-line)
          screen-coords (fn [[x y]] [x  (+ top-line (- y scroll))])] ;; Not dealing with horizontal scroll.
      (when header-line
        (puts 0 (dec top-line) (pad (xdisp/format-mode-line header-line nil window buffer) cols) reverse-video))
      (let [[[rbx rby] [rex rey]]
            (if (and mark-active? selected-window?)
              [(screen-coords (point-coords (dec (editfns/region-beginning))))
               (screen-coords (point-coords (dec (editfns/region-end))))]
              [[-1 -1] [-1 -1]])]
        (dotimes [n total-lines]
          (let [screen-line (+ top-line n)
                text (pad (nth lines (+ scroll n) " ") cols)]
            (cond
             (= screen-line rby rey) (do
                                       (puts 0 screen-line (subs text 0 rbx))
                                       (puts rbx screen-line (subs text rbx rex) region-colors)
                                       (puts rex screen-line (subs text rex)))
             (= screen-line rby) (do
                                   (puts 0 screen-line (subs text 0 rbx))
                                   (puts rbx screen-line (subs text rbx) region-colors))
             (= screen-line rey) (do
                                   (puts 0 screen-line (subs text 0 rex) region-colors)
                                   (puts rex screen-line (subs text rex)))
             (< rby screen-line rey) (puts 0 screen-line text region-colors)
             :else (puts 0 screen-line text)))))
      (when selected-window?
        (let [[px py] (screen-coords (point-coords (dec pt)))]
          (.setCursorPosition screen (TerminalPosition. px py))))
      (when mode-line
        (puts 0 (+ top-line total-lines)
              (pad (xdisp/format-mode-line mode-line nil window buffer) cols)
              {:bg TextColor$ANSI/WHITE})))))
(defn render-window [^Window window x y width height]
  ;; We should walk the tree, splitting windows as we go.
  ;; top or left children in turn have next siblings all sharing this area.
  ;; A live window is a normal window with buffer.
  (reset! (.top-line window) y)
  (reset! (.left-col window) x)
  ;; "normal" size is a weight between 0 - 1.0, should hopfully add up.
  (reset! (.total-cols window) (long (* @(.normal-cols window) width)))
  (reset! (.total-lines window) (long (* @(.normal-lines window) height)))
  (condp some [window]
    window/window-live-p (render-live-window window)
    window/window-top-child (throw (UnsupportedOperationException.))
    window/window-left-child (throw (UnsupportedOperationException.))))
(def size (atom nil))
(defn update-terminal-size []
  (reset! size (let [size (.getTerminalSize (.getTerminal screen))]
                 [(.getColumns size) (.getRows size)])))
(defn display-using-lanterna []
  (let [[width height] @size
        mini-buffer-window (window/minibuffer-window)
        mini-buffer (- height (window/window-total-height mini-buffer-window))
        menu-bar-mode (data/symbol-value 'menu-bar-mode)
        menu-bar (if menu-bar-mode 1 0)]
    (when menu-bar-mode
      (puts 0 0 (pad (render-menu-bar) width) reverse-video))
    (render-window (window/frame-root-window) 0 menu-bar
                   width (- mini-buffer menu-bar))
    (render-window (window/minibuffer-window) 0 mini-buffer
                   width (window/window-total-height mini-buffer-window))
    (.refresh screen)))
(def running (atom nil))
(def ^InputStreamReader in (InputStreamReader. System/in))
(defn stop-ui []
  (reset! running :stop)
  (while @running
    (Thread/sleep 20)))
(defn running? []
  (true? @running))

Not the real thing, but keeps the UI changing while using the REPL before we got a real command loop.

(defn start-render-loop []
  (reset! running true)
  (blank)
  (future
    (while (running?)
      (try
        (display-using-lanterna)
        (Thread/sleep 15)
        (catch Exception e
          (reset! running nil)
          (binding [*ns* (the-ns 'clojure.core)]
            (timbre/error e "An error occured during the render loop"))
          (throw e))))
    (reset! running nil)))
(defn start-command-loop []
  (reset! running true)
  (future
    ((ns-resolve 'deuce.emacs.keyboard 'drain-input-stream))
    (while (running?)
      (try
        (let [def (keymap/key-binding (keyboard/read-key-sequence-vector nil))]
          (when (and def (not (keymap/keymapp def)))
            (keyboard/command-execute def)))
        (catch ExceptionInfo e
          (binding [*ns* (the-ns 'clojure.core)]
            (timbre/error (.getMessage e))))
        (catch Exception e
          ;; This is a simplification, but makes you aware of the error without tailing the log.
          ((ns-resolve 'deuce.emacs.keyboard 'echo) (.getMessage e))
          (binding [*ns* (the-ns 'clojure.core)]
            (timbre/error (el/cause e) "An error occured during the input loop")))))))
(defn init-clipboard []
  (let [clipboard (.getSystemClipboard (Toolkit/getDefaultToolkit))]
    (el/setq interprogram-cut-function
             #(let [selection (StringSelection. %)]
                (.setContents clipboard selection selection)))
    (el/setq interprogram-paste-function
             #(.getData clipboard DataFlavor/stringFlavor))))
(defn inside-emacs? []
  (= "dumb" (System/getenv "TERM")))
(defn start-ui []
  (start-render-loop)
  (start-command-loop))
(declare init-user-classpath)

Callback run by faces/tty-run-terminal-initialization based on deuce.emacs.term/tty-type returning "lanterna" Has Emacs Lisp proxy in deuce.emacs.

(defn terminal-init-lanterna []
  (try
    (when-not (inside-emacs?)
      (init-user-classpath)
      ((ns-resolve 'deuce.emacs.terminal 'init-initial-terminal))
      (def screen (terminal/frame-terminal))
      (def text-graphics (.newTextGraphics screen))
      ;; We need to deal with resize later, it queries and gets the result on System/in which we have taken over.
      ;; Initialize the real TERM, should setup input-decode-map and local-function-key-map
      (eval/eval '(tty-run-terminal-initialization (selected-frame)
                                                   (getenv-internal "TERM")))
      (update-terminal-size)
      (init-clipboard)
      (start-ui))
    (catch Exception e
      (when screen
        (.stopScreen screen))
      (timbre/error e "An error occured during Lanterna init")
      (throw e))))
(def deuce-dot-d (str (doto (io/file (System/getProperty "user.home") ".deuce.d")
                        .mkdirs)))
(def ^:dynamic *emacs-compile-path* *compile-path*)
(defn init-user-classpath []
  (dp/add-classpath-url (ClassLoader/getSystemClassLoader) (.toURL (io/file deuce-dot-d)))
  (alter-var-root #'*emacs-compile-path* (constantly deuce-dot-d)))
(defn load-user-init-file []
  (let [init-file (io/file deuce-dot-d "init.clj")]
    (try
      (when (.exists init-file)
        (load-file (str init-file)))
      (catch Exception e
        (timbre/error e (format "An error occurred while loading `%s':" (str init-file)))))))
(defn restart []
  (let [args (next (data/symbol-value 'command-line-args))]
    (terminal/delete-terminal)
    (some-> 'deuce.main/-main resolve (apply args))
    (terminal-init-lanterna)
    :ok))
(timbre/merge-config!
 {:appenders
  {:deuce-buffer-appender
   {:min-level :debug :enabled? true :async? true
    :fn (fn [{:keys [output-fn] :as data}]
          (binding [buffer/*current-buffer* (buffer/get-buffer-create "*Deuce*")]
            (editfns/insert (str (output-fn data) \newline))))}
   :println (merge (timbre-appenders/println-appender)
                   {:enabled? (inside-emacs?)})
   :spit (merge (timbre-appenders/spit-appender {:fname (str (io/file deuce-dot-d "deuce.log"))})
                {:min-level :debug :enabled? true})}})

We want to support emacs -q initially. -q is --no-init-file

(defn -main [& args]
  (timbre/debug "Starting Deuce")
  (let [option #(hash-set (str "-" %) (str "--" %))
        inhibit-window-system (atom nil)
        args (map
              #(condp some [%]
                 (option "script") "-scriptload"
                 (option "version") (do (printf "GNU Emacs %s\n" (data/symbol-value 'emacs-version))
                                        (printf "%s\n" (data/symbol-value 'emacs-copyright))
                                        (printf "GNU Emacs comes with ABSOLUTELY NO WARRANTY.\n")
                                        (printf "You may redistribute copies of Emacs\n")
                                        (printf "under the terms of the GNU General Public License.\n")
                                        (printf "For more information about these matters, ")
                                        (printf "see the file named COPYING.\n")
                                        (flush)
                                        (System/exit 0))
                 (option "batch") (do (el/setq noninteractive true) nil)
                 (option "nrepl") (nrepl 7888)
                 #{"-nw" "--no-window-system,"} (do (reset! inhibit-window-system true))
                 %) args)]
    (el/setq command-line-args (alloc/cons "src/bootstrap-emacs" (apply alloc/list (remove nil? args))))
    (lread/load "deuce-loadup.el")
    (when (data/symbol-value 'init-file-user)
      (load-user-init-file))
    ;; /* Enter editor command loop.  This never returns.  */
    (keyboard/recursive-edit)))
 
(ns deuce.emacs-lisp
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [clojure.pprint :as pp]
            [clojure.walk :as w]
            [deuce.emacs-lisp.cons :as cons])
  (:use [taoensso.timbre :as timbre
         :only (trace debug info warn error fatal spy)])
  (:import [clojure.lang Var ExceptionInfo IMeta]
           [java.io Writer]
           [java.lang.reflect Method])
  (:refer-clojure :exclude [defmacro and or cond let while eval set compile]))
(timbre/merge-config! {:timestamp-opts {:pattern "HH:mm:ss,SSS"}
                       :appenders {:println {:min-level :error}}})
(timbre/set-level! :debug)
(set! *warn-on-reflection* true)
(create-ns 'deuce.emacs)
(create-ns 'deuce.emacs-lisp.globals)
(declare clojure-special-forms throw throw* defvar el->clj eval emacs-lisp-backquote defvar-helper*)
(defn vector-reader [v]
  (object-array (vec v)))
(defn symbol-reader [s]
  (symbol nil s))
(defn sym [s]
  (c/cond
    (true? s)'#el/sym "true"
    (nil? s) '#el/sym "nil"
    :else (symbol nil (name s))))
(defn not-null? [object]
  (when-not (c/or (nil? object) (c/= () object) (false? object))
    object))
(defn global [s]
  (ns-resolve 'deuce.emacs-lisp.globals (sym s)))
(defn fun [s]
  (condp some [s]
    fn? s
    var? (fun @s)
    symbol? (c/let [f (ns-resolve 'deuce.emacs (sym s))]
              ;; Not sure we want alias handling leaking down to here.
              ;; On the other hand, 24.3 uses defalias + lambda as primary macros.
              ;; Hack to protect against backquote alias, needs proper fix.
              (if-let [alias (c/and (not= '#el/sym "\\`" s)
                                    (-> f meta :alias))]
                (if (symbol? alias) ;; See binding/mode-specific-command-prefix
                  (fun alias)
                  alias)
                f))
    (every-pred seq? (comp '#{lambda keymap} first)) s ;; symbol-function should really be permissive about this.
    (throw* 'invalid-function (list s))))
(defn maybe-sym [x]
  (if (symbol? x) (sym x) x))
(defn emacs-lisp-error [tag value]
  (proxy [ExceptionInfo] [(str tag) {:tag tag :value value}]
    (getMessage [] (str this))
    (toString []
      (str (cons (:tag (.data ^ExceptionInfo this))
                 (c/let [d (:value (.-data ^ExceptionInfo this))]
                   (if (seq? d) d [d])))))))
(defn throw* [tag value]
  (throw (emacs-lisp-error tag value)))
(defn scope [&env]
  (c/set (remove #(re-find #"__\d+" (name %)) (keys &env))))
(def ^:dynamic *dynamic-vars* {})
(def symbol-plists (atom {}))

There's also an obsolete (as of Emacs 22.2) concept of frame locals. See deuce.emacs.data/make-variable-frame-local and deuce.emacs.frame/modify-frame-parameters This is the set of variables which can potentially be buffer local, values are stored in local-var-alist on Buffer. It's initialized by deuce.emacs.buffer/init-buffer-locals

(def buffer-locals (atom #{}))
(defn el-var-buffer-local [needs-to-exist? name]
  (when-let [buffer ((fun 'current-buffer))]
    (c/let [buffer-local (@(:local-var-alist buffer) name)]
      (if-not needs-to-exist?
        (c/or buffer-local
              (when (contains? @buffer-locals name)
                (c/let [v (Var/create)]
                  (swap! (:local-var-alist buffer) assoc name v)
                  v)))
        (when (c/and buffer-local (bound? buffer-local)) buffer-local)))))
(defn el-var [name]
  ((some-fn *dynamic-vars* (partial el-var-buffer-local true) global) name))
(defn el-var-get* [name]
  (c/let [name (sym name)]
    (if-let [v (el-var name)]
      @v
      (throw* 'void-variable (list name)))))
(c/defmacro el-var-get [name]
  (c/let [name (sym name)]
    (if (c/and (symbol? name) (name &env))
      `(if (var? ~name)
         (if (bound? ~name) @~name
             (throw* '~'void-variable (list '~name)))
         ~name)
      `(el-var-get* '~name))))
(defn el-var-set-default* [name value]
  (if-let [v (global name)]
    (alter-var-root v (constantly value))
    @(global (defvar-helper* 'deuce.emacs-lisp.globals name value))))
(c/defmacro el-var-set-default [name value]
  (c/let [name (sym name)]
    `(el-var-set-default* '~name ~value)))
(defn el-var-set* [name-or-var value]
  (if-let [^Var v (c/or (c/and (var? name-or-var) name-or-var)
                        ((some-fn *dynamic-vars* (partial el-var-buffer-local false)) name-or-var))]
    (if (c/or (c/and (.hasRoot v) (not (.getThreadBinding v))) (not (bound? v)))
      (alter-var-root v (constantly value))
      (var-set v value))
    (el-var-set-default* name-or-var value)))
(c/defmacro el-var-set [name value]
  (c/let [name (sym name)]
    `(el-var-set* ~(if (c/and (symbol? name) (name &env))
                     `~name
                     `'~name)
                  ~value)))
(defn dynamic-binding? []
  (not (el-var-get lexical-binding)))
(c/defmacro with-local-el-vars [name-vals-vec & body]
  (c/let [vars (vec (map sym (take-nth 2 name-vals-vec)))
          vals (vec (take-nth 2 (rest name-vals-vec)))]
    `(c/let [vars# (hash-map ~@(interleave (map #(list 'quote %) vars)
                                           (map #(do `(c/or (*dynamic-vars* '~%) (global '~%)
                                                            (.setDynamic (Var/create)))) vars)))]
       (with-bindings (zipmap (map vars# '~vars) ~vals)
         (binding [*dynamic-vars* (if (dynamic-binding?) (merge *dynamic-vars* vars#) {})]
           (c/let [{:syms ~vars} vars#]
             ~@body))))))
(def ^:dynamic *disallow-undefined* #{})

build cached invoker to use once target is resolved?

(defn delayed-eval* [expr]
  (binding [*disallow-undefined* (conj *disallow-undefined* (first expr))]
    (eval expr)))
(c/defmacro delayed-eval [expr]
  `(delayed-eval* '~expr))
(defn expand-dotted-lists [x]
  (if (c/or (cons/dotted-list? x) (cons/dotted-pair? x))
    (apply cons/list x)
    x))

Break this up and explain what the different branches are doing and why.

(defn el->clj [x]
  (cond-> (condp some [x]
            #{()} nil
            seq? (c/let [[fst & rst] x]
                   (if (c/and (symbol? fst)
                              (not= 'progn fst)
                              (-> (fun fst) meta :macro))
                     (if (c/or (clojure-special-forms fst) ('#{let lambda} fst)) ;; defun defvar ?
                       (if (= 'quote fst)
                         (if-let [s (c/and (symbol? (first rst)) (not (next rst)) (first rst))]
                           (list 'quote (if (= "deuce.emacs" (namespace s)) (sym s) s))
                           (if (= '(()) rst) () x))
                         (apply cons/list (c/cons (symbol "deuce.emacs-lisp" (name fst)) rst)))
                       (apply cons/list x))
                     (if (#{`el-var-get `el-var-set `el-var-set-default `delayed-eval
                            '#el/sym "\\," '#el/sym "\\,@"} fst)
                       x
                       (if (=  '#el/sym "\\`" fst)
                         (emacs-lisp-backquote x) ;; See below, we dont want to duplicate this if not necessary.
                         (if (c/and (symbol? fst)
                                    (not (namespace fst))
                                    (not (fun fst)))
                           (if (*disallow-undefined* fst)
                             (do (debug fst "RECURSIVE UNDEFINED DISALLOWED")
                                 `(throw* '~'void-function '~fst))
                             (do (debug fst "NOT DEFINED")
                                 (list `delayed-eval x)))
                           (expand-dotted-lists (c/cons
                                                 (if (seq? fst) (el->clj fst) fst)
                                                 (map el->clj rst))))))))
            symbol? (if (namespace x)
                      (if (-> (resolve x) meta :macro) (resolve x) x)
                      (if (#{'#el/sym "\\," '#el/sym "\\,@" '.} x)
                        x
                        (list `el-var-get x)))
            x)
    (instance? IMeta x) (some-> (with-meta (meta x)))))
(defn ^Throwable cause [^Throwable e]
  (if-let [e (.getCause e)]
    (recur e)
    e))
(def ^Method clojure-syntax-quote
  (doto
      (.getDeclaredMethod clojure.lang.LispReader$SyntaxQuoteReader
                          "syntaxQuote"
                          (into-array [Object]))
    (.setAccessible true)))
(defn syntax-quote* [form]
  (.invoke clojure-syntax-quote nil (into-array [form])))

Emacs Lisp allows an atom to be spliced if it is in the last position, like this: (let ((upat 'x) (sym 'x)) `(match ,sym ,@upat)) => (match x . x) Doesn't handle this wonderful case: `,@2 => 2

(defn maybe-splice-dotted-list [x]
  (if ((some-fn seq? nil?) x) x `(. ~x)))

There's a version of this already defined as macro in backquote.el, use it / override it? What's their relationship?

(defn emacs-lisp-backquote [form]
  (w/postwalk
   #(c/cond
      (c/and (seq? %) (seq? (last %)) (= `unquote-splicing (first (last %))))
      (if (butlast %)
        (concat (butlast %) `((unquote-splicing (maybe-splice-dotted-list ~(second (last %))))))
        (second (last %)))
      (c/and (seq? %) (= '#el/sym "\\`" (first %)))
      (el->clj (syntax-quote* (second %)))
      (= '#el/sym "\\," %) `unquote
      (= '#el/sym "\\,@" %) `unquote-splicing
      :else %) form))
(defn compile [emacs-lisp]
  (try
    (when emacs-lisp (c/eval (if (meta emacs-lisp) (with-meta emacs-lisp nil) emacs-lisp)))
    (catch ExceptionInfo e
      (throw e))
    (catch RuntimeException e
      (do
        (error (-> e cause .getMessage) (with-out-str (pp/pprint emacs-lisp)))
        (throw e)))))

Defined in eval.clj

(defn eval [body & [lexical]]
  (binding [*ns* (the-ns 'deuce.emacs)
            *compile-files* false]
    (with-bindings (if lexical {(global 'lexical-binding) true} {})
      (maybe-sym (compile (el->clj body))))))
(defn parse-doc-string [[doc & rst :as body]]
  (if (string? doc)
    [doc rst]
    [nil body]))
(defn meta-walk [inner outer form]
  (cond-> (w/walk inner outer form)
    (instance? IMeta form) (with-meta (meta form))))
(defn normalize-form-for-macro
  ([form] (normalize-form-for-macro identity form))
  ([f form]
   (meta-walk (partial normalize-form-for-macro f) identity (f form))))
(defn def-helper-process-var* [f needs-intern? name doc interactive emacs-lisp? el-arglist]
  (c/let [m (merge {:doc doc}
                   (when interactive {:interactive (second interactive)})
                   (when emacs-lisp?
                     {:el-arglist el-arglist
                      :el-file (when-let [file (el-var 'load-file-name)]
                                 @file)}))]
    (if (var? f)
      (do
        (alter-meta! f merge m)
        (alter-var-root f (constantly (with-meta @f (meta f))))
        (when needs-intern?
          (intern 'deuce.emacs (with-meta name (dissoc (meta f) :name)) @f)
          (ns-unmap 'deuce.emacs needs-intern?)))
      (with-meta f m))))
(c/defmacro def-helper* [what name arglist & body]
  (c/let [[docstring body] (parse-doc-string body)
          name (sym name)
          el-arglist arglist
          rest-arg (maybe-sym (second (drop-while (complement '#{&rest}) arglist)))
          [arg & args :as arglist] (map sym (replace '{&rest &} arglist))
          [arglist &optional optional-args] (if (= '&optional arg)
                                              [() arg args]
                                              (partition-by '#{&optional} arglist))
          arglist (concat arglist (when &optional ['& (vec optional-args)]))
          [[interactive] body] (split-with #(c/and (seq? %)
                                                   (= 'interactive (first %))) body)
          emacs-lisp? (= (the-ns 'deuce.emacs) *ns*)
          macro? (= `c/defmacro what)
          doc (apply str docstring)
          arglist (w/postwalk maybe-sym arglist)
          the-args (remove '#{&} (flatten arglist))
          needs-intern? (when (c/and (re-find #"/" (c/name name)) (not= '/ name))
                          (sym (s/replace (c/name name) "/" "SLASH")))
          not-implemented? (c/or (= [docstring] body) (empty? body))]
    `(def-helper-process-var*
       (~what ~(if needs-intern? needs-intern? name) ~(vec arglist)
              ~(when not-implemented?
                 `(binding [*ns* (the-ns 'clojure.core)]
                    (warn ~(c/name name) "NOT IMPLEMENTED")))
              ~(if emacs-lisp?
                 `(c/let ~(if rest-arg
                            `[~rest-arg (if-let [r# ~rest-arg] (apply cons/list r#) nil)]
                            [])
                    (c/let [result# (with-local-el-vars ~(vec (mapcat #(c/list % %) the-args))
                                      (progn ~@body))]
                      ;; There's something wrong with the returned forms, hence the prewalk
                      (if ~macro?
                        (normalize-form-for-macro (el->clj result#))
                        result#)))
                 `(do ~@body)))
       '~needs-intern? '~name ~doc '~interactive '~emacs-lisp? '~el-arglist)))
(def override? '#{apply-partially})

Define NAME as a function. The definition is (lambda ARGLIST [DOCSTRING] BODY...). See also the function `interactive'.

(c/defmacro defun
  {:arglists '([NAME ARGLIST [DOCSTRING] BODY...])}
  [name arglist & body]
  (c/let [name (sym name)]
    `(do ~(when-not (override? name)
            `(def-helper* defn ~name ~arglist ~@body))
         '~name)))

Return a lambda expression. A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is self-quoting; the result of evaluating the lambda expression is the expression itself. The lambda expression may then be treated as a function, i.e., stored as the function value of a symbol, passed to funcall' ormapcar', etc.

ARGS should take the same form as an argument list for a `defun'. DOCSTRING is an optional documentation string. If present, it should describe how to call the function. But documentation strings are usually not useful in nameless functions. INTERACTIVE should be a call to the function `interactive', which see. It may also be omitted. BODY should be a list of Lisp expressions.

Defined in subr.el

(c/defmacro lambda
  {:arglists '([ARGS [DOCSTRING] [INTERACTIVE] BODY])}
  [& cdr]
  (c/let [[args & body] cdr
          [docstring _] (parse-doc-string body)
          doc (apply str docstring)
          vars (scope &env)
          vars (vec (remove (c/set args) vars))]
    ;; This is wrong as it won't share updates between original definition and the lambda var.
    ;; Yet to see if this ends up being a real issue. A few days later: Indeed it is!
    `(c/let [closure# (zipmap '~vars
                              (map #(c/let [^Var v# (if (dynamic-binding?) ;; Temporary hack.
                                                      (if (var? %) % (Var/create %))
                                                      (Var/create (if (var? %) (deref %) %)))]
                                      (.setDynamic v#))
                                   ~vars))]
       (with-meta
         (def-helper* fn lambda ~args
           (binding [*dynamic-vars* (if (dynamic-binding?)
                                      (merge *dynamic-vars* closure#) {})]
             (c/let [{:syms ~vars} closure#]
               (progn ~@body)))) {:doc ~doc}))))

Return a function that is a partial application of FUN to ARGS. ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called.

Defined in subr.el

(defn apply-partially
  [fun & args]
  (fn partial [& new-args]
    (apply (deuce.emacs-lisp/fun fun) (concat args new-args))))

Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used for optimizing the way calls to FUNC are compiled; the form returned by BODY should do the same thing as a call to the normal function called FUNC, though possibly more efficiently. Note that, like regular macros, compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to "punt" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo.

Defined in cl-macs.el. Optimizes existing fns which complicates things a lot.

(c/defmacro define-compiler-macro
  {:arglists '([FUNC ARGS &rest BODY])}
  [func args & body])

Do BODYFORM, protecting with UNWINDFORMS. If BODYFORM completes normally, its value is returned after executing the UNWINDFORMS. If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.

(c/defmacro unwind-protect
  {:arglists '([BODYFORM UNWINDFORMS...])}
  [bodyform & unwindforms]
  `(try
     ~(el->clj bodyform)
     (finally (progn ~@unwindforms))))

Regain control when an error is signaled. Executes BODYFORM and returns its value if no error happens. Each element of HANDLERS looks like (CONDITION-NAME BODY...) where the BODY is made of Lisp expressions.

A handler is applicable to an error if CONDITION-NAME is one of the error's condition names. If an error happens, the first applicable handler is run.

The car of a handler may be a list of condition names instead of a single condition name; then it handles all of them. If the special condition name `debug' is present in this list, it allows another condition in the list to run the debugger if `debug-on-error' and the other usual mechanisms says it should (otherwise, `condition-case' suppresses the debugger).

When a handler handles an error, control returns to the `condition-case' and it executes the handler's BODY... with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error. (If VAR is nil, the handler can't access that information.) Then the value of the last BODY form is returned from the `condition-case' expression.

See also the function `signal' for more info.

(c/defmacro condition-case
  {:arglists '([VAR BODYFORM &rest HANDLERS])}
  [var bodyform & handlers]
  (c/let [var (if (= () var) nil var)]
    `(try
       ~(el->clj bodyform)
       (catch ExceptionInfo e#
         (c/let [~(if var var (gensym "_")) (cons/pair (:tag (ex-data e#))
                                                       (:value (ex-data e#)))]
           (case (:tag (ex-data e#))
             ~@(apply concat (for [[c & h] handlers
                                   :let [c (if (seq? c) c [c])]]
                               (apply concat (for [c c] `[~(sym c) (progn ~@h)]))))
             (throw e#)))))))

Try each clause until one succeeds. Each clause looks like (CONDITION BODY...). CONDITION is evaluated and, if the value is non-nil, this clause succeeds: then the expressions in BODY are evaluated and the last one's value is the value of the cond-form. If no clause succeeds, cond returns nil. If a clause has one element, as in (CONDITION), CONDITION's value if non-nil is returned from the cond-form.

(c/defmacro cond
  {:arglists '([CLAUSES...])}
  [& clauses]
  `(c/cond
     ~@(->> clauses
            (map #(do [`(not-null? ~(el->clj (first %)))
                       (if (= 1 (count %)) (el->clj (first %)) `(progn ~@(rest %)))]))
            (apply concat))))
(c/defmacro setq-helper* [default? sym-vals]
  (c/let [emacs-lisp? (= (the-ns 'deuce.emacs) *ns*)]
    `(c/let
         ~(reduce into []
                  (for [[s v] (partition 2 2 nil sym-vals)
                        :let [s (sym s)]]
                    [(sym s) (if default?
                               `(el-var-set-default ~s ~(if emacs-lisp? (el->clj v) v))
                               `(el-var-set ~s ~(if emacs-lisp? (el->clj v) v)))]))
       ~(first (last (partition 2 2 nil sym-vals))))))

Set each SYM to the value of its VAL. The symbols SYM are variables; they are literal (not evaluated). The values VAL are expressions; they are evaluated. Thus, (setq x (1+ y)) sets x' to the value of(1+ y)'. The second VAL is not computed until after the first SYM is set, and so on; each VAL can use the new value of variables set earlier in the `setq'. The return value of the `setq' form is the value of the last VAL.

(c/defmacro setq
  {:arglists '([[SYM VAL]...])}
  [& sym-vals]
  `(setq-helper* false ~sym-vals))

Return the argument, without evaluating it. (quote x)' yieldsx'. Warning: `quote' does not construct its return value, but just returns the value that was pre-constructed by the Lisp reader (see info node `(elisp)Printed Representation'). This means that '(a . b) is not identical to (cons 'a 'b): the former does not cons. Quoting should be reserved for constants that will never be modified by side-effects, unless you like self-modifying code. See the common pitfall in info node `(elisp)Rearrangement' for an example of unexpected results when a quoted object is modified.

(c/defmacro ^:clojure-special-form quote
  {:arglists '([ARG])}
  [arg]
  `(quote ~arg))

Revisit using Atoms, will make closure capture easier. We use the dynamic-vars var for dynamic scope anyway. Bindings refering to other bindings and modifying them don't work properly. The vars must be created here instead of in with-local-el-vars (which might be removed). Everytime you make a 'sane' assumption you're bound to find some Emacs Lisp breaking it: (let* ((x 2) (y (setq x 4))) (+ x y)) => 8 Also: Needs to support delayed-eval referring to earlier bindings on rhs. (currently requires the binding to be in &env). Need to deal with dots in symbols here. desktop.el has things like (let ((q.txt "something..")))

(c/defmacro let-helper* [can-refer? varlist & body]
  (c/let [varlist (map #(if (symbol? %) [% nil] %) varlist)
          illegal-symbols (into {} (map #(c/let [v (name (first %))]
                                           (when (re-find #"\." v)
                                             [(first %)
                                              (sym (s/replace v "." "_dot_"))]))
                                        varlist))
          all-vars (map (comp sym first) (w/postwalk-replace illegal-symbols varlist))
          temps (zipmap all-vars (repeatedly #(gensym "local__")))]
    `(c/let ~(vec (concat
                   (interleave (map (if can-refer? identity temps) all-vars)
                               (map (comp el->clj second) varlist))
                   (when-not can-refer? (interleave all-vars (map temps all-vars)))))
       (with-local-el-vars ~(interleave all-vars all-vars)
         (progn ~@(if (seq illegal-symbols) (w/postwalk-replace illegal-symbols body) body))))))

Bind variables according to VARLIST then eval BODY. The value of the last form in BODY is returned. Each element of VARLIST is a symbol (which is bound to nil) or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). All the VALUEFORMs are evalled before any symbols are bound.

(c/defmacro let
  {:arglists '([VARLIST BODY...])}
  [varlist & body]
  `(let-helper* false ~varlist ~@body))

Define SYMBOL as a constant variable. This declares that neither programs nor users should ever change the value. This constancy is not actually enforced by Emacs Lisp, but SYMBOL is marked as a special variable so that it is never lexically bound.

The `defconst' form always sets the value of SYMBOL to the result of evalling INITVALUE. If SYMBOL is buffer-local, its default value is what is set; buffer-local values are not affected. If SYMBOL has a local binding, then this form sets the local binding's value. However, you should normally not make local bindings for variables defined with this form.

The optional DOCSTRING specifies the variable's documentation string.

(c/defmacro defconst
  {:arglists '([SYMBOL INITVALUE [DOCSTRING]])}
  [symbol initvalue & [docstring]]
  (c/let [symbol (sym symbol)]
    `(do
       (-> (intern (create-ns 'deuce.emacs-lisp.globals)
                   '~symbol
                   ~(el->clj initvalue))
           (alter-meta! merge {:doc ~(apply str docstring)}))
       '~symbol)))

Eval FIRST and BODY sequentially; return value from FIRST. The value of FIRST is saved during the evaluation of the remaining args, whose values are discarded.

(c/defmacro prog1
  {:arglists '([FIRST BODY...])}
  [first & body]
  `(c/let [result# ~(el->clj first)]
     (progn ~@body)
     result#))

Eval FORM1, FORM2 and BODY sequentially; return value from FORM2. The value of FORM2 is saved during the evaluation of the remaining args, whose values are discarded.

(c/defmacro prog2
  {:arglists '([FORM1 FORM2 BODY...])}
  [form1 form2 & body]
  `(progn ~form1
          (prog1 ~form2
                 ~@body)))

Set the default value of variable VAR to VALUE. VAR, the variable name, is literal (not evaluated); VALUE is an expression: it is evaluated and its value returned. The default value of a variable is seen in buffers that do not have their own values for the variable.

More generally, you can use multiple variables and values, as in (setq-default VAR VALUE VAR VALUE...) This sets each VAR's default value to the corresponding VALUE. The VALUE for the Nth VAR can refer to the new default values of previous VARs.

(c/defmacro setq-default
  {:arglists '([[VAR VALUE]...])}
  [& var-values]
  `(setq-helper* true ~var-values))

Eval args until one of them yields non-nil, then return that value. The remaining args are not evalled at all. If all args return nil, return nil.

(c/defmacro or
  {:arglists '([CONDITIONS...])}
  [& conditions]
  `(c/or ~@(map #(do `(not-null? ~(el->clj %))) conditions)))

If TEST yields non-nil, eval BODY... and repeat. The order of execution is thus TEST, BODY, TEST, BODY and so on until TEST returns nil.

(c/defmacro while
  {:arglists '([TEST BODY...])}
  [test & body]
  `(c/while (not-null? ~(el->clj test)) (progn ~@body)))

Define NAME as a macro. The actual definition looks like (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...). When the macro is called, as in (NAME ARGS...), the function (lambda ARGLIST BODY...) is applied to the list ARGS... as it appears in the expression, and the result should be a form to be evaluated instead of the original.

DECL is a declaration, optional, which can specify how to indent calls to this macro, how Edebug should handle it, and which argument should be treated as documentation. It looks like this: (declare SPECS...) The elements can look like this: (indent INDENT) Set NAME's `lisp-indent-function' property to INDENT.

(debug DEBUG)
Set NAME's `edebug-form-spec' property to DEBUG.  (This is
equivalent to writing a `def-edebug-spec' for the macro.)

(doc-string ELT)
Set NAME's `doc-string-elt' property to ELT.
(c/defmacro defmacro
  {:arglists '([NAME ARGLIST [DOCSTRING] [DECL] BODY...])}
  [name arglist & body]
  (c/let [name (sym name)]
    `(do
       ~(when-not ((ns-interns 'deuce.emacs-lisp) name)
          `(def-helper* c/defmacro ~name ~arglist ~@body))
       '~name)))

Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be compiled. `quote' cannot do that.

(c/defmacro function
  {:arglists '([ARG])}
  [arg]
  (if (c/and (seq? arg) (symbol? (first arg)) (= 'lambda (sym (first arg))))
    (el->clj arg)
    `(quote ~arg)))

Eval args until one of them yields nil, then return nil. The remaining args are not evalled at all. If no arg yields nil, return the last arg's value.

(c/defmacro and
  {:arglists '([CONDITIONS...])}
  [& conditions]
  `(c/and ~@(map #(do `(not-null? ~(el->clj %))) conditions)))

Eval BODY forms sequentially and return value of last one.

(c/defmacro progn
  {:arglists '([BODY...])}
  [& body]
  `(do ~@(map el->clj body)))

Bind variables according to VARLIST then eval BODY. The value of the last form in BODY is returned. Each element of VARLIST is a symbol (which is bound to nil) or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). Each VALUEFORM can refer to the symbols already bound by this VARLIST.

(c/defmacro ^:clojure-special-form let*
  {:arglists '([VARLIST BODY...])}
  [varlist & body]
  `(let-helper* true ~varlist ~@body))
(defn defvar-helper* [ns symbol & [initvalue docstring]]
  (c/let [symbol (sym symbol)
          ^Var default (global symbol)
          m (meta default)]
    (->
     ^Var (intern (create-ns ns)
                  symbol
                  (c/or (when default
                          (.getRawRoot default))
                        initvalue))
     .setDynamic
     (alter-meta! merge (merge m {:doc (apply str docstring)})))
    symbol))

Define SYMBOL as a variable, and return SYMBOL. You are not required to define a variable in order to use it, but defining it lets you supply an initial value and documentation, which can be referred to by the Emacs help facilities and other programming tools. The `defvar' form also declares the variable as "special", so that it is always dynamically bound even if `lexical-binding' is t.

The optional argument INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void. If SYMBOL is buffer-local, its default value is what is set; buffer-local values are not affected. If INITVALUE is missing, SYMBOL's value is not set.

If SYMBOL has a local binding, then this form affects the local binding. This is usually not what you want. Thus, if you need to load a file defining variables, with this form or with `defconst' or `defcustom', you should always load that file outside any bindings for these variables. (defconst' anddefcustom' behave similarly in this respect.)

The optional argument DOCSTRING is a documentation string for the variable.

To define a user option, use defcustom' instead ofdefvar'. The function `user-variable-p' also identifies a variable as a user option if its DOCSTRING starts with *, but this behavior is obsolete.

(c/defmacro defvar
  {:arglists '([SYMBOL &optional INITVALUE DOCSTRING])}
  [symbol & [initvalue docstring]]
  (c/let [emacs-lisp? (= (the-ns 'deuce.emacs) *ns*)]
    `(defvar-helper* 'deuce.emacs-lisp.globals '~(sym symbol)
       ~(if emacs-lisp? (el->clj initvalue) initvalue) ~docstring)))

Throw to the catch for TAG and return VALUE from it. Both TAG and VALUE are evalled.

defined as fn in eval.clj

(c/defmacro ^:clojure-special-form throw
  {:arglists '([TAG VALUE])}
  [tag value]
  `(throw* ~tag ~value))

Eval BODY allowing nonlocal exits using `throw'. TAG is evalled to get the tag to use; it must not be nil.

Then the BODY is executed. Within BODY, a call to throw' with the same TAG exits BODY and thiscatch'. If no throw happens, `catch' returns the value of the last BODY form. If a throw happens, it specifies the value to return from `catch'.

(c/defmacro ^:clojure-special-form catch
  {:arglists '([TAG BODY...])}
  [tag & body]
  `(try
     (progn ~@body)
     (catch ExceptionInfo e#
       (if (= ~(el->clj tag) (:tag (ex-data e#)))
         (:value (ex-data e#))
         (throw e#)))
     (catch Exception e#
       (c/let [tag# (resolve ~tag)]
         (if (c/and tag# (instance? tag# (cause e#)))
           e#
           (throw e#))))))

If COND yields non-nil, do THEN, else do ELSE... Returns the value of THEN or the value of the last of the ELSE's. THEN must be one expression, but ELSE... can be zero or more expressions. If COND yields nil, and there are no ELSE's, the value is nil.

(c/defmacro ^:clojure-special-form if
  {:arglists '([COND THEN ELSE...])}
  [cond then & else]
  `(c/cond (not-null? ~(el->clj cond)) ~(el->clj then)
           :else (progn ~@else)))

Execute BODY, saving and restoring current buffer's restrictions. The buffer's restrictions make parts of the beginning and end invisible. (They are set up with narrow-to-region' and eliminated withwiden'.) This special form, `save-restriction', saves the current buffer's restrictions when it is entered, and restores them when it is exited. So any `narrow-to-region' within BODY lasts only until the end of the form. The old restrictions settings are restored even in case of abnormal exit (throw or error).

The value returned is the value of the last form in BODY.

Note: if you are using both save-excursion' andsave-restriction', use `save-excursion' outermost: (save-excursion (save-restriction ...))

(c/defmacro save-restriction
  {:arglists '([&rest BODY])}
  [& body]
  `(c/let [current-buffer# ~(with-meta `((fun 'current-buffer)) {:tag 'deuce.emacs.data.Buffer})
           begv# @(.begv current-buffer#)
           zv# @(.zv current-buffer#)]
     (try
       (progn ~@body)
       (finally
         ((fun 'narrow-to-region) begv# zv#)))))

Save point, mark, and current buffer; execute BODY; restore those things. Executes BODY just like `progn'. The values of point, mark and the current buffer are restored even in case of abnormal exit (throw or error). The state of activation of the mark is also restored.

This construct does not save `deactivate-mark', and therefore functions that change the buffer will still cause deactivation of the mark at the end of the command. To prevent that, bind deactivate-mark' withlet'.

If you only want to save the current buffer but not point nor mark, then just use save-current-buffer', or evenwith-current-buffer'.

(c/defmacro save-excursion
  [& body]
  `(c/let [current-buffer# ((fun 'current-buffer))
           point# ((fun 'point))
           mark# ((fun 'mark-marker))]
     (try
       (progn ~@body)
       (finally
         ((fun 'set-buffer) current-buffer#)
         ((fun 'goto-char) point#)
         ((fun 'set-marker) mark# ((fun 'marker-position) mark#) current-buffer#)))))

Specify a way of parsing arguments for interactive use of a function. For example, write (defun foo (arg buf) "Doc string" (interactive "P\nbbuffer: ") .... ) to make ARG be the raw prefix argument, and set BUF to an existing buffer, when `foo' is called as a command. The "call" to `interactive' is actually a declaration rather than a function; it tells `call-interactively' how to read arguments to pass to the function. When actually called, `interactive' just returns nil.

Usually the argument of `interactive' is a string containing a code letter followed optionally by a prompt. (Some code letters do not use I/O to get the argument and do not use prompts.) To get several arguments, concatenate the individual strings, separating them by newline characters. Prompts are passed to format, and may use % escapes to print the arguments that have already been read. If the argument is not a string, it is evaluated to get a list of arguments to pass to the function. Just `(interactive)' means pass no args when calling interactively.

Code letters available are: a -- Function name: symbol with a function definition. b -- Name of existing buffer. B -- Name of buffer, possibly nonexistent. c -- Character (no input method is used). C -- Command name: symbol with interactive function definition. d -- Value of point as number. Does not do I/O. D -- Directory name. e -- Parameterized event (i.e., one that's a list) that invoked this command. If used more than once, the Nth `e' returns the Nth parameterized event. This skips events that are integers or symbols. f -- Existing file name. F -- Possibly nonexistent file name. G -- Possibly nonexistent file name, defaulting to just directory name. i -- Ignored, i.e. always nil. Does not do I/O. k -- Key sequence (downcase the last event if needed to get a definition). K -- Key sequence to be redefined (do not downcase the last event). m -- Value of mark as number. Does not do I/O. M -- Any string. Inherits the current input method. n -- Number read using minibuffer. N -- Numeric prefix arg, or if none, do like code `n'. p -- Prefix arg converted to number. Does not do I/O. P -- Prefix arg in raw form. Does not do I/O. r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O. s -- Any string. Does not inherit the current input method. S -- Any symbol. U -- Mouse up event discarded by a previous k or K argument. v -- Variable name: symbol that is user-variable-p. x -- Lisp expression read but not evaluated. X -- Lisp expression read and evaluated. z -- Coding system. Z -- Coding system, nil if no prefix arg.

In addition, if the string begins with `*', an error is signaled if the buffer is read-only. If `@' appears at the beginning of the string, and if the key sequence used to invoke the command includes any mouse events, then the window associated with the first of those events is selected before the command is run. If the string begins with ^' andshift-select-mode' is non-nil, Emacs first calls the function `handle-shift-selection'. You may use @',*', and `^' together. They are processed in the order that they appear, before reading any arguments.

(c/defmacro interactive
  "Specify a way of parsing arguments for interactive use of a function.
  For example, write
   (defun foo (arg buf) \"Doc string\" (interactive \"P\\nbbuffer: \") .... )
   to make ARG be the raw prefix argument, and set BUF to an existing buffer,
   when `foo' is called as a command.
  The \"call\" to `interactive' is actually a declaration rather than a function;
   it tells `call-interactively' how to read arguments
   to pass to the function.
  When actually called, `interactive' just returns nil.
  Usually the argument of `interactive' is a string containing a code letter
   followed optionally by a prompt.  (Some code letters do not use I/O to get
   the argument and do not use prompts.)  To get several arguments, concatenate
   the individual strings, separating them by newline characters.
  Prompts are passed to format, and may use % escapes to print the
   arguments that have already been read.
  If the argument is not a string, it is evaluated to get a list of
   arguments to pass to the function.
  Just `(interactive)' means pass no args when calling interactively.
  Code letters available are:
  a -- Function name: symbol with a function definition.
  b -- Name of existing buffer.
  B -- Name of buffer, possibly nonexistent.
  c -- Character (no input method is used).
  C -- Command name: symbol with interactive function definition.
  d -- Value of point as number.  Does not do I/O.
  D -- Directory name.
  e -- Parameterized event (i.e., one that's a list) that invoked this command.
       If used more than once, the Nth `e' returns the Nth parameterized event.
       This skips events that are integers or symbols.
  f -- Existing file name.
  F -- Possibly nonexistent file name.
  G -- Possibly nonexistent file name, defaulting to just directory name.
  i -- Ignored, i.e. always nil.  Does not do I/O.
  k -- Key sequence (downcase the last event if needed to get a definition).
  K -- Key sequence to be redefined (do not downcase the last event).
  m -- Value of mark as number.  Does not do I/O.
  M -- Any string.  Inherits the current input method.
  n -- Number read using minibuffer.
  N -- Numeric prefix arg, or if none, do like code `n'.
  p -- Prefix arg converted to number.  Does not do I/O.
  P -- Prefix arg in raw form.  Does not do I/O.
  r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
  s -- Any string.  Does not inherit the current input method.
  S -- Any symbol.
  U -- Mouse up event discarded by a previous k or K argument.
  v -- Variable name: symbol that is user-variable-p.
  x -- Lisp expression read but not evaluated.
  X -- Lisp expression read and evaluated.
  z -- Coding system.
  Z -- Coding system, nil if no prefix arg.
  In addition, if the string begins with `*', an error is signaled if
    the buffer is read-only.
  If `@' appears at the beginning of the string, and if the key sequence
   used to invoke the command includes any mouse events, then the window
   associated with the first of those events is selected before the
   command is run.
  If the string begins with `^' and `shift-select-mode' is non-nil,
   Emacs first calls the function `handle-shift-selection'.
  You may use `@', `*', and `^' together.  They are processed in the
   order that they appear, before reading any arguments."
  {:arglists '([&optional ARGS])}
  [& args])

Save the current buffer; execute BODY; restore the current buffer. Executes BODY just like `progn'.

(c/defmacro save-current-buffer
  {:arglists '([&rest BODY])}
  [& body]
  `(c/let [current-buffer# ((fun 'current-buffer))]
     (try
       (progn ~@body)
       (finally
         ((fun 'set-buffer) current-buffer#)))))
(def clojure-special-forms
  (->> (ns-map 'deuce.emacs-lisp)
       (filter (comp :clojure-special-form meta val))
       (into {})))
(defn check-type [pred x]
  (if ((fun pred) x)
    x
    (deuce.emacs-lisp/throw 'wrong-type-argument (cons/list pred x))))

Navgeet's helper macro, will revisit, basically condition-case but for use from Clojure

(c/defmacro try-with-tag [& exprs]
  (c/let [catch-clauses (c/filter #(c/= (first %) 'catch) exprs)
          finally-clause (c/filter #(c/= (first %) 'finally) exprs)
          try-exprs (c/remove #(c/or (c/= (first %) 'finally) (c/= (first %) 'catch)) exprs)]
    `(try ~@try-exprs
          ~@(for [expr catch-clauses]
              (c/let [[_ tag e & exprs] expr]
                `(catch ExceptionInfo e#
                   (if (= ~tag (:tag (ex-data e#)))
                     (c/let [~e e#]
                       (do ~@exprs))
                     (throw e#)))))
          ~@finally-clause)))
 
(ns deuce.emacs.keyboard
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.java.shell :as sh]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.callint :as callint]
            [deuce.emacs.casefiddle :as casefiddle]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.frame :as frame]
            [deuce.emacs.keymap :as keymap]
            [deuce.emacs.macros :as macros]
            [deuce.emacs.term :as term]
            [deuce.emacs.terminal :as terminal]
            [deuce.emacs.window :as window]
            [deuce.emacs-lisp.parser :as parser]
            [taoensso.timbre :as timbre])
  (:import [sun.misc Signal SignalHandler]
           [java.io InputStreamReader])
  (:refer-clojure :exclude []))

Last input event that was part of a command.

(defvar last-command-event nil)

If not -1, an object to be read as next command input event.

(defvar unread-command-char nil)

Function to call to handle deferred actions, after each command. This function is called with no arguments after each command whenever `deferred-action-list' is non-nil.

(defvar deferred-action-function nil)

Last input event.

(defvar last-input-event nil)

Non-nil means menu bar, specified Lucid style, needs to be recomputed.

(defvar lucid-menu-bar-dirty-flag nil)

Number of input events between auto-saves. Zero means disable autosaving due to number of characters typed.

You can customize this variable.

(defvar auto-save-interval nil)

Non-nil means generate motion events for mouse motion.

(defvar track-mouse nil)

Non-nil if the key sequence activating this command was shift-translated. Shift-translation occurs when there is no binding for the key sequence as entered, but a binding was found by changing an upper-case letter to lower-case, or a shifted function key to an unshifted one.

(defvar this-command-keys-shift-translated nil)

Normal hook run before each command is executed. If an unhandled error happens in running this hook, the function in which the error occurred is unconditionally removed, since otherwise the error might happen repeatedly and make Emacs nonfunctional.

(defvar pre-command-hook nil)

Keymap that translates key sequences to key sequences during input. This is used mainly for mapping key sequences into some preferred key events (symbols).

The `read-key-sequence' function replaces any subsequence bound by `local-function-key-map' with its binding. More precisely, when the active keymaps have no binding for the current key sequence but `local-function-key-map' binds a suffix of the sequence to a vector or string, `read-key-sequence' replaces the matching suffix with its binding, and continues with the new sequence.

If the binding is a function, it is called with one argument (the prompt) and its return value (a key sequence) is used.

The events that come from bindings in `local-function-key-map' are not themselves looked up in `local-function-key-map'.

For example, suppose local-function-key-map' bindsESC O P' to [f1]. Typing ESC O P' toread-key-sequence' would return [f1]. Typing `C-x ESC O P' would return [?\C-x f1]. If [f1] were a prefix key, typing `ESC O P x' would return [f1 x].

`local-function-key-map' has a separate binding for each terminal device. See Info node `(elisp)Multiple Terminals'. If you need to define a binding on all terminals, change `function-key-map' instead. Initially, `local-function-key-map' is an empty keymap that has `function-key-map' as its parent on all terminal devices.

(defvar local-function-key-map nil
  "Keymap that translates key sequences to key sequences during input.
  This is used mainly for mapping key sequences into some preferred
  key events (symbols).
  The `read-key-sequence' function replaces any subsequence bound by
  `local-function-key-map' with its binding.  More precisely, when the
  active keymaps have no binding for the current key sequence but
  `local-function-key-map' binds a suffix of the sequence to a vector or
  string, `read-key-sequence' replaces the matching suffix with its
  binding, and continues with the new sequence.
  If the binding is a function, it is called with one argument (the prompt)
  and its return value (a key sequence) is used.
  The events that come from bindings in `local-function-key-map' are not
  themselves looked up in `local-function-key-map'.
  For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
  Typing `ESC O P' to `read-key-sequence' would return [f1].  Typing
  `C-x ESC O P' would return [?\\C-x f1].  If [f1] were a prefix key,
  typing `ESC O P x' would return [f1 x].
  `local-function-key-map' has a separate binding for each terminal
  device.  See Info node `(elisp)Multiple Terminals'.  If you need to
  define a binding on all terminals, change `function-key-map'
  instead.  Initially, `local-function-key-map' is an empty keymap that
  has `function-key-map' as its parent on all terminal devices.")

List of active absolute time timers in order of increasing time.

(defvar timer-list nil)

The ERASE character as set by the user with stty.

(defvar tty-erase-char nil)

Command to run when `help-char' character follows a prefix key. This command is used only when there is no actual binding for that character after that prefix key.

(defvar prefix-help-command nil)

When `input-method-function' is called, hold the previous echo area message. This variable exists because `read-event' clears the echo area before running the input method. It is nil if there was no message.

(defvar input-method-previous-message nil)

List of input events to recognize as meaning Help. These work just like the value of `help-char' (see that).

You can customize this variable.

(defvar help-event-list nil)

Maximum mouse movement between clicks to make a double-click. On window-system frames, value is the number of pixels the mouse may have moved horizontally or vertically between two clicks to make a double-click. On non window-system frames, value is interpreted in units of 1/8 characters instead of pixels.

This variable is also the threshold for motion of the mouse to count as a drag.

You can customize this variable.

(defvar double-click-fuzz nil)

Alist of system-specific X windows key symbols. Each element should have the form (N . SYMBOL) where N is the numeric keysym code (sans the "system-specific" bit 1<<28) and SYMBOL is its name.

`system-key-alist' has a separate binding for each terminal device. See Info node `(elisp)Multiple Terminals'.

(defvar system-key-alist nil)

List of events to be processed as input by input methods. These events are processed after `unread-command-events', but before actual keyboard input. If there's an active input method, the events are given to `input-method-function'.

(defvar unread-input-method-events nil)

Nonzero means echo unfinished commands after this many seconds of pause. The value may be integer or floating point. If the value is zero, don't echo at all.

You can customize this variable.

(defvar echo-keystrokes 1)

List of events to be processed as input by input methods. These events are processed before `unread-command-events' and actual keyboard input, but are not given to `input-method-function'.

(defvar unread-post-input-method-events nil)

A mask of additional modifier keys to use with every keyboard character. Emacs applies the modifiers of the character stored here to each keyboard character it reads. For example, after evaluating the expression (setq extra-keyboard-modifiers ?\C-x) all input characters will have the control modifier applied to them.

Note that the character ?\C-@, equivalent to the integer zero, does not count as a control character; rather, it counts as a character with no modifiers; thus, setting `extra-keyboard-modifiers' to zero cancels any modification.

(defvar extra-keyboard-modifiers nil
  "A mask of additional modifier keys to use with every keyboard character.
  Emacs applies the modifiers of the character stored here to each keyboard
  character it reads.  For example, after evaluating the expression
      (setq extra-keyboard-modifiers ?\\C-x)
  all input characters will have the control modifier applied to them.
  Note that the character ?\\C-@, equivalent to the integer zero, does
  not count as a control character; rather, it counts as a character
  with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
  cancels any modification.")

Non-nil means to always spawn a subshell instead of suspending. (Even if the operating system has support for stopping a process.)

(defvar cannot-suspend nil)

Normal hook run after each command is executed. If an unhandled error happens in running this hook, the function in which the error occurred is unconditionally removed, since otherwise the error might happen repeatedly and make Emacs nonfunctional.

(defvar post-command-hook nil)

How long to display an echo-area message when the minibuffer is active. If the value is not a number, such messages don't time out.

(defvar minibuffer-message-timeout 2)

If non-nil, don't ignore events produced by disabled menu items and tool-bar.

Help functions bind this to allow help on disabled menu items and tool-bar buttons.

(defvar enable-disabled-menus-and-buttons nil)

If non-nil, the function that implements the current input method. It's called with one argument, a printing character that was just read. (That means a character with code 040...0176.) Typically this function uses `read-event' to read additional events. When it does so, it should first bind `input-method-function' to nil so it will not be called recursively.

The function should return a list of zero or more events to be used as input. If it wants to put back some events to be reconsidered, separately, by the input method, it can add them to the beginning of `unread-command-events'.

The input method function can find in `input-method-previous-message' the previous echo area message.

The input method function should refer to the variables input-method-use-echo-area' andinput-method-exit-on-first-char' for guidance on what to do.

(defvar input-method-function nil)

Per-terminal keymap that overrides all other local keymaps. If this variable is non-nil, it is used as a keymap instead of the buffer's local map, and the minor mode keymaps and text property keymaps. It also replaces `overriding-local-map'.

This variable is intended to let commands such as `universal-argument' set up a different keymap for reading the next command.

`overriding-terminal-local-map' has a separate binding for each terminal device. See Info node `(elisp)Multiple Terminals'.

(defvar overriding-terminal-local-map nil)

If non-nil, the function that implements the display of help. It's called with one argument, the help string to display.

(defvar show-help-function nil)

If non-nil, an active region automatically sets the primary selection. If the value is `only', only temporarily active regions (usually made by mouse-dragging or shift-selection) set the window selection.

This takes effect only when Transient Mark mode is enabled.

You can customize this variable.

(defvar select-active-regions nil)

The last command executed. Normally a symbol with a function definition, but can be whatever was found in the keymap, or whatever the variable `this-command' was set to by that command.

The value `mode-exit' is special; it means that the previous command read an event that told it to exit, and it did so and unread that event. In other words, the present command is the event that made the previous command exit.

The value `kill-region' is special; it means that the previous command was a kill command.

`last-command' has a separate binding for each terminal device. See Info node `(elisp)Multiple Terminals'.

(defvar last-command nil)

Translate table for local keyboard input, or nil. If non-nil, the value should be a char-table. Each character read from the keyboard is looked up in this char-table. If the value found there is non-nil, then it is used instead of the actual input character.

The value can also be a string or vector, but this is considered obsolete. If it is a string or vector of length N, character codes N and up are left untranslated. In a vector, an element which is nil means "no translation".

This is applied to the characters supplied to input methods, not their output. See also `translation-table-for-input'.

This variable has a separate binding for each terminal. See Info node `(elisp)Multiple Terminals'.

(defvar keyboard-translate-table nil)

Non-nil means inhibit local map menu bar menus.

You can customize this variable.

(defvar inhibit-local-menu-bar-menus nil)

List of warnings to be displayed after this command. Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]), as per the args of `display-warning' (which see). If this variable is non-nil, `delayed-warnings-hook' will be run immediately after running `post-command-hook'.

(defvar delayed-warnings-list nil)

Non-nil means `overriding-local-map' applies to the menu bar. Otherwise, the menu bar continues to reflect the buffer's local map and the minor mode maps regardless of `overriding-local-map'.

(defvar overriding-local-map-menu-flag nil)

The frame in which the most recently read event occurred. If the last event came from a keyboard macro, this is set to `macro'.

(defvar last-event-frame nil)

Last input event in a command, except for mouse menu events. Mouse menus give back keys that don't look like mouse events; this variable holds the actual mouse event that led to the menu, so that you can determine whether the command was run by mouse or not.

(defvar last-nonmenu-event nil)

Keymap defining bindings for special events to execute at low level.

(defvar special-event-map nil)

Non-nil means prompt with menus when appropriate. This is done when reading from a keymap that has a prompt string, for elements that have prompt strings. The menu is displayed on the screen if X menus were enabled at configuration time and the previous event was a mouse click prefix key. Otherwise, menu prompting uses the echo area.

You can customize this variable.

(defvar menu-prompting true)

The parent keymap of all `local-function-key-map' instances. Function key definitions that apply to all terminal devices should go here. If a mapping is defined in both the current `local-function-key-map' binding and this variable, then the local definition will take precedence.

(defvar function-key-map nil)

Contents of active region prior to buffer modification. If `select-active-regions' is non-nil, Emacs sets this to the text in the region before modifying the buffer. The next `deactivate-mark' call uses this to set the window selection.

(defvar saved-region-selection nil)

If non-nil, always suppress point adjustment.

The default value is nil, in which case, point adjustment are suppressed only after special commands that set `disable-point-adjustment' (which see) to non-nil.

(defvar global-disable-point-adjustment nil)

Interval between polling for input during Lisp execution. The reason for polling is to make C-g work to stop a running program. Polling is needed only when using X windows and SIGIO does not work. Polling is automatically disabled in all other cases.

You can customize this variable.

(defvar polling-period 2)

Keymap that overrides all other local keymaps. If this variable is non-nil, it is used as a keymap--replacing the buffer's local map, the minor mode keymaps, and char property keymaps.

(defvar overriding-local-map nil)

Form to evaluate when Emacs starts up. Useful to set before you dump a modified Emacs.

(defvar top-level nil)

Keymap that decodes input escape sequences. This is used mainly for mapping ASCII function key sequences into real Emacs function key events (symbols).

The `read-key-sequence' function replaces any subsequence bound by input-decode-map' with its binding. Contrary tofunction-key-map', this map applies its rebinding regardless of the presence of an ordinary binding. So it is more like `key-translation-map' except that it applies before `function-key-map' rather than after.

If the binding is a function, it is called with one argument (the prompt) and its return value (a key sequence) is used.

The events that come from bindings in `input-decode-map' are not themselves looked up in `input-decode-map'.

This variable is keyboard-local.

(defvar input-decode-map nil)

Last command that may be repeated. The last command executed that was not bound to an input event. This is the command `repeat' will try to repeat.

(defvar last-repeatable-command nil)

Number of input events read from the keyboard so far. This does not include events generated by keyboard macros.

(defvar num-nonmacro-input-events nil)

If non-nil, any keyboard input throws to this symbol. The value of that variable is passed to `quit-flag' and later causes a peculiar kind of quitting.

(defvar throw-on-input nil)

Same as `last-command', but never altered by Lisp code.

(defvar real-last-command nil)

Character to recognize as meaning Help. When it is read, do `(eval help-form)', and display result if it's a string. If the value of `help-form' is nil, this char can be read normally.

You can customize this variable.

(defvar help-char (int \backspace))

If non-nil, suppress point adjustment after executing a command.

After a command is executed, if point is moved into a region that has special properties (e.g. composition, display), we adjust point to the boundary of the region. But, when a command sets this variable to non-nil, we suppress the point adjustment.

This variable is set to nil before reading a command, and is checked just after executing the command.

(defvar disable-point-adjustment nil)

Enter debugger on this event. When Emacs receives the special event specified by this variable, it will try to break into the debugger as soon as possible instead of processing the event normally through `special-event-map'.

Currently, the only supported values for this variable are sigusr1' andsigusr2'.

You can customize this variable.

(defvar debug-on-event nil)

List of deferred actions to be performed at a later time. The precise format isn't relevant here; we just check whether it is nil.

(defvar deferred-action-list nil)

Number of complete key sequences read as input so far. This includes key sequences read from keyboard macros. The number is effectively the number of interactive command invocations.

(defvar num-input-keys nil)

If non-nil, function to output error messages. The arguments are the error data, a list of the form (SIGNALED-CONDITIONS . SIGNAL-DATA) such as just as `condition-case' would bind its variable to, the context (a string which normally goes at the start of the message), and the Lisp function within which the error was signaled.

(defvar command-error-function nil)

Non-nil means show the equivalent key-binding when M-x command has one. The value can be a length of time to show the message for. If the value is non-nil and not a number, we wait 2 seconds.

You can customize this variable.

(defvar suggest-key-bindings true)

List of commands which should not update the selection. Normally, if `select-active-regions' is non-nil and the mark remains active after a command (i.e. the mark was not deactivated), the Emacs command loop sets the selection to the text in the region. However, if the command is in this list, the selection is not updated.

(defvar selection-inhibit-update-commands '(handle-switch-frame handle-select-window))

List of menu bar items to move to the end of the menu bar. The elements of the list are event types that may have menu bar bindings.

(defvar menu-bar-final-items nil)

Expression evaluating to the image spec for a tool-bar separator. This is used internally by graphical displays that do not render tool-bar separators natively. Otherwise it is unused (e.g. on GTK).

(defvar tool-bar-separator-image-expression nil)

Maximum time between mouse clicks to make a double-click. Measured in milliseconds. The value nil means disable double-click recognition; t means double-clicks have no time limit and are detected by position only.

You can customize this variable.

(defvar double-click-time 500)

Meta-prefix character code. Meta-foo as command input turns into this character followed by foo.

You can customize this variable.

(defvar meta-prefix-char (int \))

Number of seconds idle time before auto-save. Zero or nil means disable auto-saving due to idleness. After auto-saving due to this many seconds of idle time, Emacs also does a garbage collection if that seems to be warranted.

You can customize this variable.

(defvar auto-save-timeout 30)

List of active idle-time timers in order of increasing time.

(defvar timer-idle-list nil)

Normal hook run when clearing the echo area.

(defvar echo-area-clear-hook nil)

The command now being executed. The command can set this variable; whatever is put here will be in `last-command' during the following command.

(defvar this-command nil)

If an editing command sets this to t, deactivate the mark afterward. The command loop sets this to nil before each command, and tests the value when the command returns. Buffer modification stores t in this variable.

(defvar deactivate-mark nil)

Form to execute when character `help-char' is read. If the form returns a string, that string is displayed. If `help-form' is nil, the help char is not recognized.

(defvar help-form nil)

List of events to be read as the command input. These events are processed first, before actual keyboard input. Events read from this list are not normally added to `this-command-keys', as they will already have been added once as they were read for the first time. An element of the form (t . EVENT) forces EVENT to be added to that list.

(defvar unread-command-events nil)

Character to see next line of menu prompt. Type this character while in a menu prompt to rotate around the lines of it.

(defvar menu-prompt-more-char (int \space))

The command bound to the current key sequence before remapping. It equals `this-command' if the original command was not remapped through any of the active keymaps. Otherwise, the value of `this-command' is the result of looking up the original command in the active keymaps.

(defvar this-original-command nil)

Keymap of key translations that can override keymaps. This keymap works like `function-key-map', but comes after that, and its non-prefix bindings override ordinary bindings. Another difference is that it is global rather than keyboard-local.

(defvar key-translation-map nil)

We bypass Lanterna with System/in but utilize their setup of private mode, see UnixTerminal/enterPrivateMode: (do (require '[clojure.java.shell :as sh]) (sh/sh "/bin/sh" "-c" "/bin/stty -echo < /dev/tty") ;; Disables echo, leave this out for manual testing. (sh/sh "/bin/sh" "-c" "/bin/stty -icanon < /dev/tty") ;; Enable all chars for reading. (sh/sh "/bin/sh" "-c" "/bin/stty min 1 < /dev/tty")) ;; Read single chars.

We report our TERM as "lanterna" to allow terminal-init-lanterna to be run first, then init the real one. All this has only been tested on TERM=xterm input-decode-map is setup in term/xterm. We should also look in local-function-key-map This interfers badly with Lanterna's get-size, occasionally locks up, needs fix.

(def ^InputStreamReader in (InputStreamReader. System/in))
(def ^:private char-buffer (atom []))
(def ^:private  event-buffer (atom []))
(defn ^:private drain-input-stream []
  (while (.ready in)
    (.read in)))

DEUCE: For reference, this is the main low level read_char function in Emacs. We don't use nmaps (or most arguments yet). We use currentTimeMillis for internal times instead of Emacs style time. Maybe totally revamped, but let's start with something "similar" to Emacs. Is normally called from readkeysequence (C internal version) from commandloop1.

/* read a character from the keyboard; call the redisplay if needed */ /* commandflag 0 means do not autosave, but do redisplay. -1 means do not redisplay, but do autosave. 1 means do both. */

/* The arguments MAPS and NMAPS are for menu prompting. MAPS is an array of keymaps; NMAPS is the length of MAPS.

PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence (or not reading a key sequence). If PREV_EVENT is t, that is a "magic" value that says not to run input methods, but in other respects to act as if not reading a key sequence.

If USEDMOUSEMENU is non-null, then we set *USEDMOUSEMENU to 1 if we used a mouse menu to read the input, or zero otherwise. If USEDMOUSEMENU is null, we don't dereference it.

Value is -2 when we find input on another keyboard. A second call to read_char will read it.

If ENDTIME is non-null, it is a pointer to an EMACSTIME specifying the maximum time to wait until. If no input arrives by that time, stop waiting and return nil.

Value is t if we showed a menu and the user rejected it. */

(defn ^:private read-char [commandflag maps prev-event used-mouse-menu end-time]
  (loop []
    (when (or (nil? end-time)
              (> end-time (System/currentTimeMillis)))
      (if (.ready in)
        (.read in)
        (do (Thread/sleep 15)
            (recur))))))
(defn ^:private echo [message]
  ;; Emacs uses 2 echo areas and switches between them.
  (let [echo-area (buffer/get-buffer-create " *Echo Area 0*")]
    (if (seq message)
      (binding [buffer/*current-buffer* echo-area]
        (buffer/erase-buffer)
        (editfns/insert message))
      (binding [buffer/*current-buffer* echo-area]
        (buffer/erase-buffer)))
    (window/set-window-buffer (window/minibuffer-window) echo-area)))

Convert the event description list EVENT-DESC to an event type. EVENT-DESC should contain one base event type (a character or symbol) and zero or more modifier names (control, meta, hyper, super, shift, alt, drag, down, double or triple). The base must be last. The return value is an event type (a character or symbol) which has the same base event type and all the specified modifiers.

(defun event-convert-list (event-desc)
  (let [[mods base] [(set (butlast event-desc)) (last event-desc)]]
    (parser/event-convert-list-internal mods base)))

Return t if command input is currently available with no wait. Actually, the value is nil only if we can be sure that no input is available; if there is a doubt, the value is t.

(defun input-pending-p ())

Return position information for buffer POS in WINDOW. POS defaults to point in WINDOW; WINDOW defaults to the selected window.

Return nil if position is not visible in window. Otherwise, the return value is similar to that returned by `event-start' for a mouse click at the upper left corner of the glyph corresponding to the given buffer position: (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) IMAGE (DX . DY) (WIDTH . HEIGHT)) The `posn-' functions access elements of such lists.

(defun posn-at-point (&optional pos window))

Return the raw events that were read for this command. More generally, it returns the last key sequence read, either by the command loop or by `read-key-sequence'. Unlike `this-single-command-keys', this function's value shows the events before all translations (except for input methods). The value is always a vector.

(defun this-single-command-raw-keys ())

Return vector of last 300 events, not counting those from keyboard macros.

(defun recent-keys ())

Return information about the way Emacs currently reads keyboard input. The value is a list of the form (INTERRUPT FLOW META QUIT), where INTERRUPT is non-nil if Emacs is using interrupt-driven input; if nil, Emacs is using CBREAK mode. FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the terminal; this does not apply if Emacs uses interrupt-driven input. META is t if accepting 8-bit input with 8th bit as Meta flag. META nil means ignoring the top bit, on the assumption it is parity. META is neither t nor nil if accepting 8-bit input and using all 8 bits as the character code. QUIT is the character Emacs currently uses to quit. The elements of this list correspond to the arguments of `set-input-mode'.

(defun current-input-mode ())

Execute CMD as an editor command. CMD must be a symbol that satisfies the `commandp' predicate. Optional second arg RECORD-FLAG non-nil means unconditionally put this command in `command-history'. Otherwise, that is done only if an arg is read using the minibuffer. The argument KEYS specifies the value to use instead of (this-command-keys) when reading the arguments; if it is nil, (this-command-keys) is used. The argument SPECIAL, if non-nil, means that this command is executing a special event, so ignore the prefix argument and don't clear it.

(defun command-execute (cmd &optional record-flag keys special)
  (el/check-type 'commandp cmd)
  (try
    ;; There are many more things that can happen here
    (el/setq last-event-frame (frame/selected-frame))
    (el/setq last-command-event (last @event-buffer))
    (el/setq last-nonmenu-event (last @event-buffer))
    ;; this-command-keys and this-command-keys-vector return the entire event-buffer as string or vector.
    ;; They are backed by one variable in C, this_command_keys.
    (reset! event-buffer [])
    (el/setq this-command cmd)
    (el/setq this-original-command cmd) ;; Need to handle remap
    (el/setq deactivate-mark nil)
    (buffer/set-buffer (window/window-buffer (window/selected-window)))
    (eval/run-hooks 'pre-command-hook)
    (timbre/debug (format "command-execute: %s" cmd))
    (when-not special
      (el/setq current-prefix-arg (data/symbol-value 'prefix-arg))
      (el/setq prefix-arg nil))
    (if (or (data/stringp cmd) (data/vectorp cmd))
      (macros/execute-kbd-macro cmd (when-not special (data/symbol-value 'current-prefix-arg)))
      (callint/call-interactively cmd record-flag keys))
    (finally
      (eval/run-hooks 'post-command-hook)
      (when (data/symbol-value 'deactivate-mark)
        (eval/funcall 'deactivate-mark))
      (el/setq this-command nil)
      (el/setq this-original-command nil)
      (el/setq last-prefix-arg (data/symbol-value 'current-prefix-arg))
      (el/setq last-command (data/symbol-value 'this-command))
      (el/setq real-last-command (data/symbol-value 'this-command)))))
(Signal/handle (Signal. "CONT")
               (proxy [SignalHandler] []
                 (handle [s] (term/resume-tty))))

Stop Emacs and return to superior process. You can resume later. If `cannot-suspend' is non-nil, or if the system doesn't support job control, run a subshell instead.

If optional arg STUFFSTRING is non-nil, its characters are stuffed to be read as terminal input by Emacs's parent, after suspension.

Before suspending, run the normal hook `suspend-hook'. After resumption run the normal hook `suspend-resume-hook'.

Some operating systems cannot stop the Emacs process and resume it later. On such systems, Emacs starts a subshell instead of suspending.

(defun suspend-emacs (&optional stuffstring)
  (interactive)
  (term/suspend-tty)
  (.invoke
   (doto (.getDeclaredMethod Signal "raise0" (into-array [Integer/TYPE]))
     (.setAccessible true)) nil (object-array [(int 20)])))

Return the current depth in recursive edits.

(defun recursion-depth ()
  0)

Like `read-key-sequence' but always return a vector.

(defun read-key-sequence-vector (prompt &optional continue-echo dont-downcase-last can-return-switch-frame cmd-loop)
  (when prompt
    (echo prompt))
  (loop [c (.read in)]
    (swap! char-buffer conj (char c))
    (let [maybe-event (object-array @char-buffer)
          decoded (keymap/lookup-key (data/symbol-value 'input-decode-map) maybe-event)]
      (if (keymap/keymapp decoded)
        (recur (.read in))
        (do (reset! char-buffer [])
            (let [event (if (data/vectorp decoded) decoded maybe-event)]
              (swap! event-buffer (comp vec concat) event)
              (if (keymap/keymapp (keymap/key-binding (object-array @event-buffer)))
                (recur (.read in))
                (object-array @event-buffer))))))))

Set mode of reading keyboard input. First arg INTERRUPT non-nil means use input interrupts; nil means use CBREAK mode. Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal (no effect except in CBREAK mode). Third arg META t means accept 8-bit input (for a Meta key). META nil means ignore the top bit, on the assumption it is parity. Otherwise, accept 8-bit input and don't use the top bit for Meta. Optional fourth arg QUIT if non-nil specifies character to use for quitting. See also `current-input-mode'.

(defun set-input-mode (interrupt flow meta &optional quit))

Read a sequence of keystrokes and return as a string or vector. The sequence is sufficient to specify a non-prefix command in the current local and global maps.

First arg PROMPT is a prompt string. If nil, do not prompt specially. Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos as a continuation of the previous key.

The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not convert the last event to lower case. (Normally any upper case event is converted to lower case if the original event is undefined and the lower case equivalent is defined.) A non-nil value is appropriate for reading a key sequence to be defined.

A C-g typed while in this function is treated like any other character, and `quit-flag' is not set.

If the key sequence starts with a mouse click, then the sequence is read using the keymaps of the buffer of the window clicked in, not the buffer of the selected window as normal.

`read-key-sequence' drops unbound button-down events, since you normally only care about the click or drag events which follow them. If a drag or multi-click event is unbound, but the corresponding click event would be bound, `read-key-sequence' turns the event into a click event at the drag's starting position. This means that you don't have to distinguish between click and drag, double, or triple events unless you want to.

`read-key-sequence' prefixes mouse events on mode lines, the vertical lines separating windows, and scroll bars with imaginary keys mode-line',vertical-line', and `vertical-scroll-bar'.

Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this function will process a switch-frame event if the user switches frames before typing anything. If the user switches frames in the middle of a key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME is nil, then the event will be put off until after the current key sequence.

read-key-sequence' checksfunction-key-map' for function key sequences, where they wouldn't conflict with ordinary bindings. See `function-key-map' for more details.

The optional fifth argument CMD-LOOP, if non-nil, means that this key sequence is being read by something that will read commands one after another. It should be nil if the caller will read just one key sequence.

(defun read-key-sequence (prompt &optional continue-echo dont-downcase-last can-return-switch-frame cmd-loop)
  (apply str (map char (read-key-sequence prompt continue-echo dont-downcase-last can-return-switch-frame cmd-loop))))

Return position information for pixel coordinates X and Y. By default, X and Y are relative to text area of the selected window. Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window. If optional fourth arg WHOLE is non-nil, X is relative to the left edge of the window.

The return value is similar to a mouse click position: (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) IMAGE (DX . DY) (WIDTH . HEIGHT)) The `posn-' functions access elements of such lists.

(defun posn-at-x-y (x y &optional frame-or-window whole))

Start writing all keyboard characters to a dribble file called FILE. If FILE is nil, close any open dribble file. The file will be closed when Emacs exits.

(defun open-dribble-file (file)
  (interactive "FOpen dribble file: "))

Invoke the editor command loop recursively. To get out of the recursive edit, a command can do `(throw 'exit nil)'; that tells this function to return. Alternatively, `(throw 'exit t)' makes this function signal an error. This function is called by the editor initialization to begin editing.

(defun recursive-edit ()
  ;; Increases command_loop_level, calls the internal C functions:
  ;;   recursive_edit_1 -> command_loop -> command_loop_2 -> command_loop_1
  ;; Each adding some layers of condition case and other things (redisplay, buffer).
  ;; command_loop_1 is the real command loop. Calls read_key_sequence.
  (interactive))

Return the key sequence that invoked this command, as a vector. However, if the command has called `read-key-sequence', it returns the last key sequence that has been read.

See also `this-command-keys'.

(defun this-command-keys-vector ())

Exit all recursive editing levels. This also exits all active minibuffers.

(defun top-level ()
  (interactive))

Read function name, then read its arguments and call it.

To pass a numeric argument to the command you are invoking with, specify the numeric argument to this command.

Noninteractively, the argument PREFIXARG is the prefix argument to give to the command you invoke, if it asks for an argument.

(defun execute-extended-command (prefixarg)
  (interactive "P")
  (el/setq prefix-arg prefixarg)
  (command-execute (symbol nil ((el/fun 'read-extended-command)))))

Discard the contents of the terminal input buffer. Also end any kbd macro being defined.

(defun discard-input ())

Make the unread events replace the last command and echo. Used in `universal-argument-other-key'.

`universal-argument-other-key' rereads the event just typed. It then gets translated through `function-key-map'. The translated event has to replace the real events, both in the value of (this-command-keys) and in echoing. To achieve this, `universal-argument-other-key' calls `reset-this-command-lengths', which discards the record of reading these events the first time.

(defun reset-this-command-lengths ())

Enable or disable 8-bit input on TERMINAL. If META is t, Emacs will accept 8-bit input, and interpret the 8th bit as the Meta modifier.

If META is nil, Emacs will ignore the top bit, on the assumption it is parity.

Otherwise, Emacs will accept and pass through 8-bit input without specially interpreting the top bit.

This setting only has an effect on tty terminal devices.

Optional parameter TERMINAL specifies the tty terminal device to use. It may be a terminal object, a frame, or nil for the terminal used by the currently selected frame.

See also `current-input-mode'.

(defun set-input-meta-mode (meta &optional terminal))

Return the key sequence that invoked this command. More generally, it returns the last key sequence read, either by the command loop or by `read-key-sequence'. Unlike `this-command-keys', this function's value does not include prefix arguments. The value is always a vector.

(defun this-single-command-keys ())

Exit from the innermost recursive edit or minibuffer.

(defun exit-recursive-edit ()
  (interactive))

Specify character used for quitting. QUIT must be an ASCII character.

This function only has an effect on the controlling tty of the Emacs process.

See also `current-input-mode'.

(defun set-quit-char (quit))

Abort the command that requested this recursive edit or minibuffer input.

(defun abort-recursive-edit ()
  (interactive))

Set interrupt mode of reading keyboard input. If INTERRUPT is non-nil, Emacs will use input interrupts; otherwise Emacs uses CBREAK mode.

See also `current-input-mode'.

(defun set-input-interrupt-mode (interrupt))

Parse the event symbol. For internal use.

(defun internal-event-symbol-parse-modifiers (symbol))

Enable or disable ^S/^Q flow control for output to TERMINAL. If FLOW is non-nil, flow control is enabled and you cannot use C-s or C-q in key sequences.

This setting only has an effect on tty terminals and only when Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.

See also `current-input-mode'.

(defun set-output-flow-control (flow &optional terminal))

Return the key sequence that invoked this command. However, if the command has called `read-key-sequence', it returns the last key sequence that has been read. The value is a string or a vector.

See also `this-command-keys-vector'.

(defun this-command-keys ())

Return the current length of Emacs idleness, or nil. The value when Emacs is idle is a list of three integers. The first has the most significant 16 bits of the seconds, while the second has the least significant 16 bits. The third integer gives the microsecond count.

The value when Emacs is not idle is nil.

The microsecond count is zero on systems that do not provide resolution finer than a second.

(defun current-idle-time ())

Clear out the vector that `this-command-keys' returns. Also clear the record of the last 100 events, unless optional arg KEEP-RECORD is non-nil.

(defun clear-this-command-keys (&optional keep-record))
 
(ns deuce.emacs.casefiddle
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.string :as s])
  (:refer-clojure :exclude []))

Convert following word (or ARG words) to upper case, moving over. With negative argument, convert previous words but do not move. See also `capitalize-word'.

(defun upcase-word (arg)
  (interactive "p"))

Convert argument to upper case and return that. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy. See also capitalize',downcase' and `upcase-initials'.

(defun upcase (obj)
  (if ((some-fn char? integer?) obj)
    (int (Character/toUpperCase (int obj)))
    (s/upper-case obj)))

Capitalize the following word (or ARG words), moving over. This gives the word(s) a first character in upper case and the rest lower case. With negative argument, capitalize previous words but do not move.

(defun capitalize-word (arg)
  (interactive "p"))

Convert the region to lower case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on.

(defun downcase-region (beg end)
  (interactive "r"))

Convert the region to capitalized form. Capitalized form means each word's first character is upper case and the rest of it is lower case. In programs, give two arguments, the starting and ending character positions to operate on.

(defun capitalize-region (beg end)
  (interactive "r"))

Convert the initial of each word in the argument to upper case. Do not change the other letters of each word. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy.

(defun upcase-initials (obj)
  (s/replace obj #"\w+" #(apply str (s/upper-case (first %)) (rest %))))

Convert following word (or ARG words) to lower case, moving over. With negative argument, convert previous words but do not move.

(defun downcase-word (arg)
  (interactive "p"))

Convert the region to upper case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on. See also `capitalize-region'.

(defun upcase-region (beg end)
  (interactive "r"))

Convert argument to capitalized form and return that. This means that each word's first character is upper case and the rest is lower case. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy.

(defun capitalize (obj)
  (s/capitalize obj))

Upcase the initial of each word in the region. Subsequent letters of each word are not changed. In programs, give two arguments, the starting and ending character positions to operate on.

(defun upcase-initials-region (beg end)
  (interactive "r"))

Convert argument to lower case and return that. The argument may be a character or string. The result has the same type. The argument object is not altered--the value is a copy.

(defun downcase (obj)
  (if ((some-fn char? integer?) obj)
    (int (Character/toLowerCase (int obj)))
    (s/lower-case obj)))
 
(ns deuce.emacs.composite
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Function to adjust composition of buffer text.

This function is called with three arguments: FROM, TO, and OBJECT. FROM and TO specify the range of text whose composition should be adjusted. OBJECT, if non-nil, is a string that contains the text.

This function is called after a text with `composition' property is inserted or deleted to keep `composition' property of buffer text valid.

The default value is the function `compose-chars-after'.

(defvar compose-chars-after-function nil)

Non-nil if Auto-Composition mode is enabled. Use the command `auto-composition-mode' to change this variable.

(defvar auto-composition-mode nil)

Function to call to compose characters automatically. This function is called from the display routine with four arguments: FROM, TO, WINDOW, and STRING.

If STRING is nil, the function must compose characters in the region between FROM and TO in the current buffer.

Otherwise, STRING is a string, and FROM and TO are indices into the string. In this case, the function must compose characters in the string.

(defvar auto-composition-function nil)

Char-table of functions for automatic character composition. For each character that has to be composed automatically with preceding and/or following characters, this char-table contains a function to call to compose that character.

The element at index C in the table, if non-nil, is a list of composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)

PATTERN is a regular expression which C and the surrounding characters must match.

PREV-CHARS is a non-negative integer (less than 4) specifying how many characters before C to check the matching with PATTERN. If it is 0, PATTERN must match C and the following characters. If it is 1, PATTERN must match a character before C and the following characters.

If PREV-CHARS is 0, PATTERN can be nil, which means that the single character C should be composed.

FUNC is a function to return a glyph-string representing a composition of the characters that match PATTERN. It is called with one argument GSTRING.

GSTRING is a template of a glyph-string to return. It is already filled with a proper header for the characters to compose, and glyphs corresponding to those characters one by one. The function must return a new glyph-string with the same header as GSTRING, or modify GSTRING itself and return it.

See also the documentation of `auto-composition-mode'.

(defvar composition-function-table nil)

Internal use only.

Return information about composition at or nearest to position POS. See `find-composition' for more details.

(defun find-composition-internal (pos limit string detail-p))

Internal use only.

Compose text between indices START and END of STRING. Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC for the composition. See `compose-string' for more details.

(defun compose-string-internal (string start end &optional components modification-func))

Internal use only.

Compose text in the region between START and END. Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC for the composition. See `compose-region' for more details.

(defun compose-region-internal (start end &optional components modification-func))

Return a glyph-string for characters between FROM and TO. If the glyph string is for graphic display, FONT-OBJECT must be a font-object to use for those characters. Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a frame, or nil for the selected frame's terminal device.

If the optional 4th argument STRING is not nil, it is a string containing the target characters between indices FROM and TO.

A glyph-string is a vector containing information about how to display a specific character sequence. The format is: [HEADER ID GLYPH ...]

HEADER is a vector of this form: [FONT-OBJECT CHAR ...] where FONT-OBJECT is a font-object for all glyphs in the glyph-string, or the terminal coding system of the specified terminal. CHARs are characters to be composed by GLYPHs.

ID is an identification number of the glyph-string. It may be nil if not yet shaped.

GLYPH is a vector whose elements have this form: [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT [ [X-OFF Y-OFF WADJUST] | nil] ] where FROM-IDX and TO-IDX are used internally and should not be touched. C is the character of the glyph. CODE is the glyph-code of C in FONT-OBJECT. WIDTH thru DESCENT are the metrics (in pixels) of the glyph. X-OFF and Y-OFF are offsets to the base position for the glyph. WADJUST is the adjustment to the normal width of the glyph.

If GLYPH is nil, the remaining elements of the glyph-string vector should be ignored.

(defun composition-get-gstring (from to font-object string))
 
(ns deuce.emacs.lread
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.java.io :as io]
            [clojure.string :as s]
            [clojure.walk :as w]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.cons :refer [car cdr] :as cons]
            [deuce.emacs-lisp.globals :as globals]
            [deuce.emacs-lisp.printer :as printer]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.character :as character]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.fileio :as fileio]
            [deuce.emacs.window :as window]
            [deuce.emacs-lisp.parser :as parser])
  (:refer-clojure :exclude [read intern load])
  (:import [java.io FileNotFoundException]
           [java.net URL]
           [clojure.lang Compiler]))

Set to non-nil when `read' encounters an old-style backquote.

(defvar old-style-backquotes nil)

List of values of all expressions which were read, evaluated and printed. Order is reverse chronological.

(defvar values nil)

Non-nil means force printing messages when loading Lisp files. This overrides the value of the NOMESSAGE argument to `load'.

(defvar force-load-messages nil)

If non-nil, add position of read symbols to `read-symbol-positions-list'.

If this variable is a buffer, then only forms read from that buffer will be added to `read-symbol-positions-list'. If this variable is t, then all read forms will be added. The effect of all other values other than nil are not currently defined, although they may be in the future.

The positions are relative to the last call to `read' or `read-from-string'. It is probably a bad idea to set this variable at the toplevel; bind it instead.

(defvar read-with-symbol-positions nil)

A list mapping read symbols to their positions. This variable is modified during calls to `read' or read-from-string', but only whenread-with-symbol-positions' is non-nil.

Each element of the list looks like (SYMBOL . CHAR-POSITION), where CHAR-POSITION is an integer giving the offset of that occurrence of the symbol from the position where read' orread-from-string' started.

Note that a symbol will appear multiple times in this list, if it was read multiple times. The list is in the same order as the symbols were read in.

(defvar read-symbol-positions-list nil)

*List of directories to search for files to load. Each element is a string (directory name) or nil (try default directory). Initialized based on EMACSLOADPATH environment variable, if any, otherwise to default specified by file `epaths.h' when Emacs was built.

(defvar load-path (alloc/list ""))

Alist mapping loaded file names to symbols and features. Each alist element should be a list (FILE-NAME ENTRIES...), where FILE-NAME is the name of a file that has been loaded into Emacs. The file name is absolute and true (i.e. it doesn't contain symlinks). As an exception, one of the alist elements may have FILE-NAME nil, for symbols and features not associated with any file.

The remaining ENTRIES in the alist element describe the functions and variables defined in that file, the features provided, and the features required. Each entry has the form `(provide . FEATURE)', (require . FEATURE)',(defun . FUNCTION)', `(autoload . SYMBOL)', (defface . SYMBOL)', or(t . SYMBOL)'. Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an autoload before this file redefined it as a function. In addition, entries may also be single symbols, which means that SYMBOL was defined by defvar' ordefconst'.

During preloading, the file name recorded is relative to the main Lisp directory. These file names are converted to absolute at startup.

(defvar load-history nil)

File name, including directory, of user's initialization file. If the file loaded had extension `.elc', and the corresponding source file exists, this variable contains the name of source file, suitable for use by functions like `custom-save-all' which edit the init file. While Emacs loads and evaluates the init file, value is the real name of the file, regardless of whether or not it has the `.elc' extension.

(defvar user-init-file nil)

List of files that were preloaded (when dumping Emacs).

(defvar preloaded-file-list nil)

Regular expression matching safe to load compiled Lisp files. When Emacs loads a compiled Lisp file, it reads the first 512 bytes from the file, and matches them against this regular expression. When the regular expression matches, the file is considered to be safe to load. See also `load-dangerous-libraries'.

(defvar bytecomp-version-regexp nil)

Full name of file being loaded by `load'.

(defvar load-file-name nil)

List of suffixes for (compiled or source) Emacs Lisp files. This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a Lisp suffix is allowed or required.

(defvar load-suffixes (alloc/list ".class" ".el"))

Non-nil means `read' converts strings to unibyte whenever possible. This is normally bound by load' andeval-buffer' to control `read', and is not meant for users to change.

(defvar load-convert-to-unibyte nil)

List of suffixes that indicate representations of the same file. This list should normally start with the empty string.

Enabling Auto Compression mode appends the suffixes in `jka-compr-load-suffixes' to this list and disabling Auto Compression mode removes them again. `load' and related functions use this list to determine whether they should look for compressed versions of a file and, if so, which suffixes they should try to append to the file name in order to do so. However, if you want to customize which suffixes the loading functions recognize as compression suffixes, you should customize `jka-compr-load-suffixes' rather than the present variable.

(defvar load-file-rep-suffixes (alloc/list ""))

Function called in `load' for loading an Emacs Lisp source file. This function is for doing code conversion before reading the source file. If nil, loading is done without any code conversion. Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where FULLNAME is the full name of FILE. See `load' for the meaning of the remaining arguments.

(defvar load-source-file-function nil)

Function used by load' andeval-region' for reading expressions. The default is nil, which means use the function `read'.

(defvar load-read-function nil)

Symbol table for use by intern' andread'. It is a vector whose length ought to be prime for best results. The vector's contents don't make sense if examined from Lisp programs; to find all the symbols in an obarray, use `mapatoms'.

(defvar obarray nil)

Non-nil means read recursive structures using #N= and #N# syntax.

(defvar read-circle nil)

List of buffers being read from by calls to eval-buffer' andeval-region'.

(defvar eval-buffer-list nil)

Non-nil means `load' should force-load all dynamic doc strings. This is useful when the file being loaded is a temporary copy.

(defvar load-force-doc-strings nil)

List of all DEFVAR_BOOL variables, used by the byte code optimizer.

(defvar byte-boolean-vars nil)

An alist of expressions to be evalled when particular files are loaded. Each element looks like (REGEXP-OR-FEATURE FORMS...).

REGEXP-OR-FEATURE is either a regular expression to match file names, or a symbol (a feature name).

When `load' is run and the file-name argument matches an element's REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol REGEXP-OR-FEATURE, the FORMS in the element are executed.

An error in FORMS does not undo the load, but does prevent execution of the rest of the FORMS.

(defvar after-load-alist nil)

Non-nil if inside of `load'.

(defvar load-in-progress nil)

Non-nil means load dangerous compiled Lisp files. Some versions of XEmacs use different byte codes than Emacs. These incompatible byte codes can make Emacs crash when it tries to execute them.

(defvar load-dangerous-libraries nil)

Used for internal purposes by `load'.

(defvar current-load-list nil)

Directory in which Emacs sources were found when Emacs was built. You cannot count on them to still be there!

(defvar source-directory nil)

Whether to use lexical binding when evaluating code. Non-nil means that the code in the current buffer should be evaluated with lexical binding. This variable is automatically set from the file variables of an interpreted Lisp file read using `load'. Unlike other file local variables, this must be set in the first line of a file.

(defvar lexical-binding nil)

Stream for read to get input from. See documentation of `read' for possible values.

(defvar standard-input nil)

Read an event object from the input stream. If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some input method is turned on in the current buffer, that input method is used for reading a character. If the optional argument SECONDS is non-nil, it should be a number specifying the maximum number of seconds to wait for input. If no input arrives in that time, return nil. SECONDS may be a floating-point value.

(defun read-event (&optional prompt inherit-input-method seconds)
  (when prompt
    ((ns-resolve 'deuce.emacs.keyboard 'echo) prompt))
  ((ns-resolve 'deuce.emacs.keyboard 'read-char) nil nil nil nil
   (when seconds
     (+ (System/currentTimeMillis)
        (* 1000 seconds)))))

Read a character from the command input (keyboard or macro). It is returned as a number. Non-character events are ignored. If the character has modifiers, they are resolved and reflected to the character code if possible (e.g. C-SPC -> 0).

If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some input method is turned on in the current buffer, that input method is used for reading a character. If the optional argument SECONDS is non-nil, it should be a number specifying the maximum number of seconds to wait for input. If no input arrives in that time, return nil. SECONDS may be a floating-point value.

(defun read-char-exclusive (&optional prompt inherit-input-method seconds)
  (when prompt
    ((ns-resolve 'deuce.emacs.keyboard 'echo) prompt))
  (let [end-time (when seconds
                   (+ (System/currentTimeMillis)
                      (* 1000 seconds)))]
    (loop []
      (let [event ((ns-resolve 'deuce.emacs.keyboard 'read-char) nil nil nil nil end-time)]
        (if (character/characterp event)
          event
          (recur))))))

Read one Lisp expression as text from STREAM, return as Lisp object. If STREAM is nil, use the value of `standard-input' (which see). STREAM or the value of `standard-input' may be: a buffer (read from point and advance it) a marker (read from where it points and advance it) a function (call it with no arguments for each character, call it with a char as argument to push a char back) a string (takes text from string, starting at the beginning) t (read text line using minibuffer and use it, or read from standard input in batch mode).

(defun read (&optional stream)
  (let [stream (or stream (data/symbol-value 'standard-input))
        stream (if (data/bufferp stream)
                 (editfns/buffer-substring (editfns/point) (inc (editfns/buffer-size)))
                 stream)]
    (first (parser/parse stream))))

Read a character from the command input (keyboard or macro). It is returned as a number. If the character has modifiers, they are resolved and reflected to the character code if possible (e.g. C-SPC -> 0).

If the user generates an event which is not a character (i.e. a mouse click or function key event), `read-char' signals an error. As an exception, switch-frame events are put off until non-character events can be read. If you want to read non-character events, or ignore them, call read-event' orread-char-exclusive' instead.

If the optional argument PROMPT is non-nil, display that as a prompt. If the optional argument INHERIT-INPUT-METHOD is non-nil and some input method is turned on in the current buffer, that input method is used for reading a character. If the optional argument SECONDS is non-nil, it should be a number specifying the maximum number of seconds to wait for input. If no input arrives in that time, return nil. SECONDS may be a floating-point value.

(defun read-char (&optional prompt inherit-input-method seconds)
  (read-char-exclusive prompt inherit-input-method seconds))

Execute the current buffer as Lisp code. When called from a Lisp program (i.e., not interactively), this function accepts up to five optional arguments: BUFFER is the buffer to evaluate (nil means use current buffer). PRINTFLAG controls printing of output: A value of nil means discard it; anything else is stream for print. FILENAME specifies the file name to use for `load-history'. UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this invocation. DO-ALLOW-PRINT, if non-nil, specifies that `print' and related functions should work normally even if PRINTFLAG is nil.

This function preserves the position of point.

(defun eval-buffer (&optional buffer printflag filename unibyte do-allow-print)
  (interactive))

Read one Lisp expression which is represented as text by STRING. Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX). FINAL-STRING-INDEX is an integer giving the position of the next remaining character in STRING. START and END optionally delimit a substring of STRING from which to read; they default to 0 and (length STRING) respectively.

(defun read-from-string (string &optional start end)
  (let [string (subs string (or start 0) (or end (count string)))]
    (try
      (if (= \{ (first string))
        (alloc/cons (read-string string) (count string))
        (parser/parse-internal string))
      (catch Exception e
        (parser/parse-internal string)))))

Execute the region as Lisp code. When called from programs, expects two arguments, giving starting and ending indices in the current buffer of the text to be executed. Programs can pass third argument PRINTFLAG which controls output: A value of nil means discard it; anything else is stream for printing it. Also the fourth argument READ-FUNCTION, if non-nil, is used instead of `read' to read each expression. It gets one argument which is the input stream for reading characters.

This function does not move point.

(defun eval-region (start end &optional printflag read-function)
  (interactive "r"))

Return the canonical symbol whose name is STRING. If there is none, one is created by this function and returned. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'.

(defun intern (string &optional obarray)
  (symbol nil string))

Return the suffixes that `load' should try if a suffix is required. This uses the variables load-suffixes' andload-file-rep-suffixes'.

(defun get-load-suffixes ()
  (apply alloc/list (remove empty? (concat globals/load-file-rep-suffixes globals/load-suffixes))))
(def ^:private access {0 fileio/file-exists-p
                       1 fileio/file-readable-p
                       2 fileio/file-writable-p
                       3 fileio/file-executable-p})
(defn ^:private locate-file [filename path suffixes predicate]
  (let [predicate (or predicate (el/fun 'file-readable-p))
        predicate (access predicate predicate)]
    (->> (for [l path
               :let [file (str l "/" filename)
                     find-resource #(let [url (str (s/replace file  #"^/*" ) %)]
                                      (or (io/resource (s/replace url "-" "_"))
                                          (io/resource url)))
                     find-file #(let [f (io/file (str file %))]
                                  (and (.exists f) (predicate (.getAbsolutePath f))
                                       (.toURL f)))]]
           [l (some identity (map (some-fn find-resource find-file) (or suffixes [])))])
         (filter (comp identity second))
         (remove #(when (= "file" (.getProtocol ^URL (second %)))
                    (.isDirectory (io/file (second %)))))
         first)))
(def ^:private ^:dynamic loads-in-progress #{})
(defn ^:private internal-path [path file]
  (s/replace (str (when (seq path) (str path "/")) file) #"^/*" ))

Execute a file of Lisp code named FILE. First try FILE with .elc' appended, then try with.el', then try FILE unmodified (the exact suffixes in the exact order are determined by `load-suffixes'). Environment variable references in FILE are replaced with their values by calling `substitute-in-file-name'. This function searches the directories in `load-path'.

If optional second arg NOERROR is non-nil, report no error if FILE doesn't exist. Print messages at start and end of loading unless optional third arg NOMESSAGE is non-nil (but `force-load-messages' overrides that). If optional fourth arg NOSUFFIX is non-nil, don't try adding suffixes .elc' or.el' to the specified name FILE. If optional fifth arg MUST-SUFFIX is non-nil, insist on the suffix .elc' or.el'; don't accept just FILE unless it ends in one of those suffixes or includes a directory name.

If this function fails to find a file, it may look for different representations of that file before trying another file. It does so by adding the non-empty suffixes in `load-file-rep-suffixes' to the file name. Emacs uses this feature mainly to find compressed versions of files when Auto Compression mode is enabled.

The exact suffixes that this function tries out, in the exact order, are given by the value of the variable `load-file-rep-suffixes' if NOSUFFIX is non-nil and by the return value of the function `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and MUST-SUFFIX are nil, this function first tries out the latter suffixes and then the former.

Loading a file records its definitions, and its `provide' and require' calls, in an element ofload-history' whose car is the file name loaded. See `load-history'.

While the file is in the process of being loaded, the variable load-in-progress' is non-nil and the variableload-file-name' is bound to the file's name.

Return t if the file exists and loads successfully.

(defun load (file &optional noerror nomessage nosuffix must-suffix)
  ;; Need to deal with -*- lexical-binding: t -*-
  (if (loads-in-progress file)
    true ;; not really correct
    (binding [loads-in-progress (conj loads-in-progress file)]
      (try
        (let [[path url] (locate-file file (data/symbol-value 'load-path)
                                      (when-not nosuffix '("" ".el")) nil)
              el-extension? (re-find #".el$" file)]
          (if-not url
            (el/throw* 'file-error (list "Cannot open load file" file)))
          (when (or (not nomessage) (data/symbol-value 'force-load-messages))
            (editfns/message "Loading %s%s..." file (if el-extension? " (source)" "")))
          (binding [globals/load-file-name (.getFile ^URL url)
                    globals/load-in-progress true]
            (let [file (internal-path path (s/replace file  #".el$" ""))
                  clj-file (str (s/replace file "-" "_") ".clj")
                  clj-name (symbol (s/replace file "/" "."))
                  last-modified #(if % (.getLastModified (.openConnection ^URL %)) -1)
                  load-raw-clj #(if-let [r (io/resource clj-file)]
                                  (with-open [r (io/reader r)]
                                    (Compiler/load r clj-file (.getName (io/file clj-file))))
                                  (throw (FileNotFoundException. "no clj file")))]
              (try
                (when (> (last-modified url) (last-modified (io/resource clj-file)))
                  (throw (FileNotFoundException. "out of date")))
                (if el-extension?
                  (load-raw-clj)
                  (c/require clj-name))
                (catch FileNotFoundException _
                  (binding [*compile-path* (or (some-> 'deuce.main/*emacs-compile-path* resolve deref)
                                               *compile-path*)]
                    (with-open [in (io/input-stream url)]
                      (let [el (parser/parse in)
                            clj-file (io/file *compile-path* clj-file)]
                        (printer/write-clojure el clj-file)
                        (if el-extension?
                          (load-raw-clj)
                          (binding [*compile-files* true]
                            (require clj-name))))))))
              true)))
        (catch Exception e
          (when-not noerror
            (throw e)))))))

Call FUNCTION on every symbol in OBARRAY. OBARRAY defaults to the value of `obarray'.

(defun mapatoms (function &optional obarray))

Search for FILENAME through PATH. Returns the file's name in absolute form, or nil if not found. If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If non-nil, PREDICATE is used instead of `file-readable-p'. PREDICATE can also be an integer to pass to the access(2) function, in which case file-name-handlers are ignored. This function will normally skip directories, so if you want it to find directories, make sure the PREDICATE function returns `dir-ok' for them.

(defun locate-file-internal (filename path &optional suffixes predicate)
  (let [[dir file] (locate-file filename path suffixes predicate)]
    (when file
      (internal-path dir (str (io/file (.getParent (io/file filename))
                                       (.getName (io/file (.getFile ^URL file)))))))))

Delete the symbol named NAME, if any, from OBARRAY. The value is t if a symbol was found and deleted, nil otherwise. NAME may be a string or a symbol. If it is a symbol, that symbol is deleted, if it belongs to OBARRAY--no other symbol is deleted. OBARRAY defaults to the value of the variable `obarray'.

(defun unintern (name obarray))

Don't use this yourself.

(defun get-file-char ())

Return the canonical symbol named NAME, or nil if none exists. NAME may be a string or a symbol. If it is a symbol, that exact symbol is searched for. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'.

(defun intern-soft (name &optional obarray)
  (intern name))
 
(ns deuce.emacs.indent
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns])
  (:refer-clojure :exclude []))

*Indentation can insert tabs if this is non-nil.

You can customize this variable.

(defvar indent-tabs-mode nil)

Return the indentation of the current line. This is the horizontal position of the character following any initial whitespace.

(defun current-indentation ())

Return the horizontal position of point. Beginning of line is column 0. This is calculated by adding together the widths of all the displayed representations of the character between the start of the previous line and point (eg. control characters will have a width of 2 or 4, tabs will have a variable width). Ignores finite width of frame, which means that this function may return values greater than (frame-width). Whether the line is visible (if `selective-display' is t) has no effect; however, ^M is treated as end of line when `selective-display' is t. Text that has an invisible property is considered as having width 0, unless `buffer-invisibility-spec' specifies that it is replaced by an ellipsis.

(defun current-column ()
  (let [point (editfns/point)
        line (.lastIndexOf (subs (editfns/buffer-string) 0 (dec point)) "\n")]
    (dec (if (= -1 line) point (dec (- point line))))))

Scan through the current buffer, calculating screen position. Scan the current buffer forward from offset FROM, assuming it is at position FROMPOS--a cons of the form (HPOS . VPOS)-- to position TO or position TOPOS--another cons of the form (HPOS . VPOS)-- and return the ending buffer position and screen location.

If TOPOS is nil, the actual width and height of the window's text area are used.

There are three additional arguments:

WIDTH is the number of columns available to display text; this affects handling of continuation lines. A value of nil corresponds to the actual number of available text columns.

OFFSETS is either nil or a cons cell (HSCROLL . TAB-OFFSET). HSCROLL is the number of columns not being displayed at the left margin; this is usually taken from a window's hscroll member. TAB-OFFSET is the number of columns of the first tab that aren't being displayed, perhaps because the line was continued within it. If OFFSETS is nil, HSCROLL and TAB-OFFSET are assumed to be zero.

WINDOW is the window to operate on. It is used to choose the display table; if it is showing the current buffer, it is used also for deciding which overlay properties apply. Note that `compute-motion' always operates on the current buffer.

The value is a list of five elements: (POS HPOS VPOS PREVHPOS CONTIN) POS is the buffer position where the scan stopped. VPOS is the vertical position where the scan stopped. HPOS is the horizontal position where the scan stopped.

PREVHPOS is the horizontal position one character back from POS. CONTIN is t if a line was continued after (or within) the previous character.

For example, to find the buffer position of column COL of line LINE of a certain window, pass the window's starting location as FROM and the window's upper-left coordinates as FROMPOS. Pass the buffer's (point-max) as TO, to limit the scan to the end of the visible section of the buffer, and pass LINE and COL as TOPOS.

(defun compute-motion (from frompos to topos width offsets window))

Indent from point with tabs and spaces until COLUMN is reached. Optional second argument MINIMUM says always do at least MINIMUM spaces even if that goes past COLUMN; by default, MINIMUM is zero.

The return value is COLUMN.

(defun indent-to (column &optional minimum)
  (interactive "NIndent to column: "))

Move point to column COLUMN in the current line. Interactively, COLUMN is the value of prefix numeric argument. The column of a character is calculated by adding together the widths as displayed of the previous characters in the line. This function ignores line-continuation; there is no upper limit on the column number a character can have and horizontal scrolling has no effect.

If specified column is within a character, point goes after that character. If it's past end of line, point goes to end of line.

Optional second argument FORCE non-nil means if COLUMN is in the middle of a tab character, change it to spaces. In addition, if FORCE is t, and the line is too short to reach COLUMN, add spaces/tabs to get there.

The return value is the current column.

(defun move-to-column (column &optional force))

Move point to start of the screen line LINES lines down. If LINES is negative, this means moving up.

This function is an ordinary cursor motion function which calculates the new position based on how text would be displayed. The new position may be the start of a line, or just the start of a continuation line. The function returns number of screen lines moved over; that usually equals LINES, but may be closer to zero if beginning or end of buffer was reached.

The optional second argument WINDOW specifies the window to use for parameters such as width, horizontal scrolling, and so on. The default is to use the selected window's parameters.

LINES can optionally take the form (COLS . LINES), in which case the motion will not stop at the start of a screen line but on its column COLS (if such exists on that line, that is).

`vertical-motion' always uses the current buffer, regardless of which buffer is displayed in WINDOW. This is consistent with other cursor motion functions and makes it possible to use `vertical-motion' in any buffer, whether or not it is currently displayed in some window.

(defun vertical-motion (lines &optional window)
  (interactive "p")
  ((ns-resolve 'deuce.emacs.cmds 'forward-line) (if (data/consp lines) (data/cdr lines) lines)))
 
(ns deuce.emacs.floatfns
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc])
  (:refer-clojure :exclude [float]))

Truncate a floating point number to an integral float value. Rounds the value toward zero.

(defun ftruncate (arg)
  (double (long arg)))

Return the tangent of ARG.

(defun tan (arg)
  (Math/tan arg))

Return the inverse tangent of the arguments. If only one argument Y is given, return the inverse tangent of Y. If two arguments Y and X are given, return the inverse tangent of Y divided by X, i.e. the angle in radians between the vector (X, Y) and the x-axis.

(defun atan (y &optional x)
  (if x
    (Math/atan2 y x)
    (Math/atan y)))

Return the exponential ARG1 ** ARG2.

(defun expt (arg1 arg2)
  (Math/pow arg1 arg2))

Return the square root of ARG.

(defun sqrt (arg)
  (Math/sqrt arg))

Return the absolute value of ARG.

(defun abs (arg)
  (if (float? arg)
    (Math/abs (double arg))
    (Math/abs (long arg))))

Construct number X from significand SGNFCAND and exponent EXP. Returns the floating point value resulting from multiplying SGNFCAND (the significand) by 2 raised to the power of EXP (the exponent).

(defun ldexp (sgnfcand &optional exponent)
  (* (Math/pow 2 (or exponent 1)) sgnfcand))

Return the smallest integer no less than ARG, as a float. (Round toward +inf.)

(defun fceiling (arg)
  (Math/ceil arg))

Return the floating point number equal to ARG.

(defun float (arg)
  (double arg))

Return the natural logarithm of ARG. If the optional argument BASE is given, return log ARG using that base.

(defun log (arg &optional base)
  (/ (Math/log arg) (if base (Math/log base) 1)))

Return the largest integer no greater than ARG. This rounds the value towards -inf. With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.

(defun floor (arg &optional divisor)
  (long (Math/floor (/ arg (or divisor 1)))))

Return the nearest integer to ARG. With optional DIVISOR, return the nearest integer to ARG/DIVISOR.

Rounding a value equidistant between two integers may choose the integer closer to zero, or it may prefer an even integer, depending on your machine. For example, (round 2.5) can return 3 on some systems, but 2 on others.

(defun round (arg &optional divisor)
  (Math/round (/ arg (double (or divisor 1)))))

Return the logarithm base 10 of ARG.

(defun log10 (arg)
  (Math/log10 arg))

Return non nil iff argument X is a NaN.

(defun isnan (x)
  (Double/isNaN x))

Return the largest integer no greater than ARG, as a float. (Round towards -inf.)

(defun ffloor (arg)
  (double (long arg)))

Truncate a floating point number to an int. Rounds ARG toward zero. With optional DIVISOR, truncate ARG/DIVISOR.

(defun truncate (arg &optional divisor)
  (long (/ arg (or divisor 1))))

Return the smallest integer no less than ARG. This rounds the value towards +inf. With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.

(defun ceiling (arg &optional divisor)
  (long (Math/ceil (/ arg (or divisor 1)))))

Return the sine of ARG.

(defun sin (arg)
  (Math/sin arg))

Copy sign of X2 to value of X1, and return the result. Cause an error if X1 or X2 is not a float.

(defun copysign (x1 x2)
  (Math/copySign (double x1) (double x2)))

Return the inverse sine of ARG.

(defun asin (arg)
  (Math/asin arg))

Return the nearest integer to ARG, as a float.

(defun fround (arg)
  (double (long arg)))

Return the inverse cosine of ARG.

(defun acos (arg)
  (Math/acos arg))

Get significand and exponent of a floating point number. Breaks the floating point number X into its binary significand SGNFCAND (a floating point value between 0.5 (included) and 1.0 (excluded)) and an integral exponent EXP for 2, such that:

X = SGNFCAND * 2^EXP

The function returns the cons cell (SGNFCAND . EXP). If X is zero, both parts (SGNFCAND and EXP) are zero.

(defun frexp (x)
  (if (zero? x)
    (alloc/cons 0.0 0)
    (let [exp (inc (Math/getExponent (double x)))]
      (alloc/cons (/ x (Math/pow 2 exp)) exp))))

Return the exponential base e of ARG.

(defun exp (arg)
  (Math/exp arg))

Return the cosine of ARG.

(defun cos (arg)
  (Math/cos arg))

Returns largest integer <= the base 2 log of the magnitude of ARG. This is the same as the exponent of a float.

(defun logb (arg)
  (Math/getExponent (double arg)))
 
(ns deuce.emacs.insdel
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Used internally by the `combine-after-change-calls' macro.

(defvar combine-after-change-calls nil)

Non-nil means enable debugging checks for invalid marker positions.

(defvar check-markers-debug-flag nil)

Non-nil means don't run any of the hooks that respond to buffer changes. This affects before-change-functions' andafter-change-functions', as well as hooks attached to text properties and overlays.

(defvar inhibit-modification-hooks nil)

This function is for use internally in `combine-after-change-calls'.

(defun combine-after-change-execute ())
 
(ns deuce.emacs.font
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Vector of valid font weight values. Each element has the form: [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols.

(defvar font-weight-table nil)

Alist of fontname patterns vs the corresponding encoding and repertory info. Each element looks like (REGEXP . (ENCODING . REPERTORY)), where ENCODING is a charset or a char-table, and REPERTORY is a charset, a char-table, or nil.

If ENCODING and REPERTORY are the same, the element can have the form (REGEXP . ENCODING).

ENCODING is for converting a character to a glyph code of the font. If ENCODING is a charset, encoding a character by the charset gives the corresponding glyph code. If ENCODING is a char-table, looking up the table by a character gives the corresponding glyph code.

REPERTORY specifies a repertory of characters supported by the font. If REPERTORY is a charset, all characters belonging to the charset are supported. If REPERTORY is a char-table, all characters who have a non-nil value in the table are supported. If REPERTORY is nil, Emacs gets the repertory information by an opened font and ENCODING.

(defvar font-encoding-alist nil)

*Logging list of font related actions and results. The value t means to suppress the logging. The initial value is set to nil if the environment variable EMACSFONTLOG is set. Otherwise, it is set to t.

(defvar font-log nil)

Alist of font width symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector.

(defvar font-width-table nil)

Vector of font slant symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector.

(defvar font-slant-table nil)

Return XLFD name of FONT. FONT is a font-spec, font-entity, or font-object. If the name is too long for XLFD (maximum 255 chars), return nil. If the 2nd optional arg FOLD-WILDCARDS is non-nil, the consecutive wildcards are folded into one.

(defun font-xlfd-name (font &optional fold-wildcards))

Return a font-object for displaying a character at POSITION. Optional second arg WINDOW, if non-nil, is a window displaying the current buffer. It defaults to the currently selected window.

(defun font-at (position &optional window string))

Return a list of variation glyphs for CHAR in FONT-OBJECT. Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID), where VARIATION-SELECTOR is a character code of variation selection (#xFE00..#xFE0F or #xE0100..#xE01EF) GLYPH-ID is a glyph code of the corresponding variation glyph.

(defun font-variation-glyphs (font-object character))

Open FONT-ENTITY.

(defun open-font (font-entity &optional size frame))

List available fonts matching FONT-SPEC on the current frame. Optional 2nd argument FRAME specifies the target frame. Optional 3rd argument NUM, if non-nil, limits the number of returned fonts. Optional 4th argument PREFER, if non-nil, is a font-spec to control the order of the returned list. Fonts are sorted by how close they are to PREFER.

(defun list-fonts (font-spec &optional frame num prefer))

Return a vector of FONT-OBJECT's glyphs for the specified characters. FROM and TO are positions (integers or markers) specifying a region of the current buffer. If the optional fourth arg OBJECT is not nil, it is a string or a vector containing the target characters.

Each element is a vector containing information of a glyph in this format: [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT] where FROM is an index numbers of a character the glyph corresponds to. TO is the same as FROM. C is the character of the glyph. CODE is the glyph-code of C in FONT-OBJECT. WIDTH thru DESCENT are the metrics (in pixels) of the glyph. ADJUSTMENT is always nil. If FONT-OBJECT doesn't have a glyph for a character, the corresponding element is nil.

(defun font-get-glyphs (font-object from to &optional object))

Set one property of FONT: give property KEY value VAL. FONT is a font-spec, a font-entity, or a font-object.

If FONT is a font-spec, KEY can be any symbol. But if KEY is the one accepted by the function `font-spec' (which see), VAL must be what allowed in `font-spec'.

If FONT is a font-entity or a font-object, KEY must not be the one accepted by `font-spec'.

(defun font-put (font prop val))

Return a newly created font-spec with arguments as properties.

ARGS must come in pairs KEY VALUE of font properties. KEY must be a valid font property name listed below:

:family',:weight', :slant',:width'

They are the same as face attributes of the same name. See `set-face-attribute'.

`:foundry'

VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.

`:adstyle'

VALUE must be a string or a symbol specifying the additional typographic style information of a font, e.g. ``sans''.

`:registry'

VALUE must be a string or a symbol specifying the charset registry and encoding of a font, e.g. ``iso8859-1''.

`:size'

VALUE must be a non-negative integer or a floating point number specifying the font size. It specifies the font size in pixels (if VALUE is an integer), or in points (if VALUE is a float).

`:name'

VALUE must be a string of XLFD-style or fontconfig-style font name.

`:script'

VALUE must be a symbol representing a script that the font must support. It may be a symbol representing a subgroup of a script listed in the variable `script-representative-chars'.

`:lang'

VALUE must be a symbol of two-letter ISO-639 language names, e.g. `ja'.

`:otf'

VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify required OpenType features.

SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
LANGSYS-TAG: OpenType language system tag symbol,
   or nil for the default language system.
GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.

GSUB and GPOS may contain `nil' element. In such a case, the font must not have any of the remaining elements.

For instance, if the VALUE is `(thai nil nil (mark))', the font must be an OpenType font whose GPOS table of `thai' script's default language system must contain `mark' feature.

(defun font-spec (&rest args))

Return a font-entity matching with FONT-SPEC on the current frame. Optional 2nd argument FRAME, if non-nil, specifies the target frame.

(defun find-font (font-spec &optional frame))

Shape the glyph-string GSTRING. Shaping means substituting glyphs and/or adjusting positions of glyphs to get the correct visual image of character sequences set in the header of the glyph-string.

If the shaping was successful, the value is GSTRING itself or a newly created glyph-string. Otherwise, the value is nil.

(defun font-shape-gstring (gstring))

Return information about FONT-OBJECT. The value is a vector: [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH CAPABILITY ]

NAME is the font name, a string (or nil if the font backend doesn't provide a name).

FILENAME is the font file name, a string (or nil if the font backend doesn't provide a file name).

PIXEL-SIZE is a pixel size by which the font is opened.

SIZE is a maximum advance width of the font in pixels.

ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in pixels.

CAPABILITY is a list whose first element is a symbol representing the font format (x, opentype, truetype, type1, pcf, or bdf) and the remaining elements describe the details of the font capability.

If the font is OpenType font, the form of the list is (opentype GSUB GPOS) where GSUB shows which "GSUB" features the font supports, and GPOS shows which "GPOS" features the font supports. Both GSUB and GPOS are lists of the format: ((SCRIPT (LANGSYS FEATURE ...) ...) ...)

If the font is not OpenType font, currently the length of the form is one.

SCRIPT is a symbol representing OpenType script tag.

LANGSYS is a symbol representing OpenType langsys tag, or nil representing the default langsys.

FEATURE is a symbol representing OpenType feature tag.

If the font is not OpenType font, CAPABILITY is nil.

(defun query-font (font-object))

Return the value of FONT's property KEY. FONT is a font-spec, a font-entity, or a font-object. KEY is any symbol, but these are reserved for specific meanings: :family, :weight, :slant, :width, :foundry, :adstyle, :registry, :size, :name, :script, :otf See the documentation of `font-spec' for their meanings. In addition, if FONT is a font-entity or a font-object, values of :script and :otf are different from those of a font-spec as below:

The value of :script may be a list of scripts that are supported by the font.

The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists representing the OpenType features supported by the font by this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...) SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType Layout tags.

(defun font-get (font key))

Return t if OBJECT is a font-spec, font-entity, or font-object. Return nil otherwise. Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check which kind of font it is. It must be one of font-spec',font-entity', `font-object'.

(defun fontp (object &optional extra-type))

Return t if and only if font-spec SPEC matches with FONT. FONT is a font-spec, font-entity, or font-object.

(defun font-match-p (spec font))

List available font families on the current frame. Optional argument FRAME, if non-nil, specifies the target frame.

(defun font-family-list (&optional frame))

Clear font cache.

(defun clear-font-cache ())

Close FONT-OBJECT.

(defun close-font (font-object &optional frame))
 
(ns deuce.emacs.textprop
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Property-list used as default values. The value of a property in this list is seen as the value for every character that does not have its own value for that property.

(defvar default-text-properties nil)

Alist of properties vs the corresponding non-stickiness. Each element has the form (PROPERTY . NONSTICKINESS).

If a character in a buffer has PROPERTY, new text inserted adjacent to the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil, inherits it if NONSTICKINESS is nil. The `front-sticky' and `rear-nonsticky' properties of the character override NONSTICKINESS.

(defvar text-property-default-nonsticky nil)

Alist of alternative properties for properties without a value. Each element should look like (PROPERTY ALTERNATIVE1 ALTERNATIVE2...). If a piece of text has no direct value for a particular property, then this alist is consulted. If that property appears in the alist, then the first non-nil value from the associated alternative properties is returned.

(defvar char-property-alias-alist nil)

If non-nil, don't run point-left' andpoint-entered' text properties. This also inhibits the use of the `intangible' text property.

(defvar inhibit-point-motion-hooks nil)

Return the position of next text property or overlay change. This scans characters forward in the current buffer from POSITION till it finds a change in some text property, or the beginning or end of an overlay, and returns the position of that. If none is found up to (point-max), the function returns (point-max).

If the optional second argument LIMIT is non-nil, don't search past position LIMIT; return LIMIT if nothing is found before LIMIT. LIMIT is a no-op if it is greater than (point-max).

(defun next-char-property-change (position &optional limit))

Remove some properties from text from START to END. The third argument LIST-OF-PROPERTIES is a list of property names to remove. If the optional fourth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. Return t if any property was actually removed, nil otherwise.

(defun remove-list-of-text-properties (start end list-of-properties &optional object))

Return the position of next property change. Scans characters forward from POSITION in OBJECT till it finds a change in some text property, then returns the position of the change. If the optional second argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. Return nil if the property is constant all the way to the end of OBJECT. If the value is non-nil, it is a position greater than POSITION, never equal.

If the optional third argument LIMIT is non-nil, don't search past position LIMIT; return LIMIT if nothing is found before LIMIT.

(defun next-property-change (position &optional object limit))

Check text from START to END for property PROPERTY not equaling VALUE. If so, return the position of the first character whose property PROPERTY is not `eq' to VALUE. Otherwise, return nil. If the optional fifth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it.

(defun text-property-not-all (start end property value &optional object))

Add properties to the text from START to END. The third argument PROPERTIES is a property list specifying the property values to add. If the optional fourth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. Return t if any property value actually changed, nil otherwise.

(defun add-text-properties (start end properties &optional object))

Return the position of previous text property or overlay change for a specific property. Scans characters backward from POSITION till it finds a change in the PROP property, then returns the position of the change. If the optional third argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it.

In a string, scan runs to the start of the string. In a buffer, it runs to (point-min), and the value cannot be less than that.

The property values are compared with `eq'. If the property is constant all the way to the start of OBJECT, return the first valid position in OBJECT. If the optional fourth argument LIMIT is non-nil, don't search back past position LIMIT; return LIMIT if nothing is found before reaching LIMIT.

(defun previous-single-char-property-change (position prop &optional object limit))

Check text from START to END for property PROPERTY equaling VALUE. If so, return the position of the first character whose property PROPERTY is `eq' to VALUE. Otherwise return nil. If the optional fifth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it.

(defun text-property-any (start end property value &optional object))

Like `get-char-property', but with extra overlay information. The value is a cons cell. Its car is the return value of `get-char-property' with the same arguments--that is, the value of POSITION's property PROP in OBJECT. Its cdr is the overlay in which the property was found, or nil, if it was found as a text property or not found at all.

OBJECT is optional and defaults to the current buffer. OBJECT may be a string, a buffer or a window. For strings, the cdr of the return value is always nil, since strings do not have overlays. If OBJECT is a window, then that window's buffer is used, but window-specific overlays are considered only if they are associated with OBJECT. If POSITION is at the end of OBJECT, both car and cdr are nil.

(defun get-char-property-and-overlay (position prop &optional object))

Return the position of previous text property or overlay change. Scans characters backward in the current buffer from POSITION till it finds a change in some text property, or the beginning or end of an overlay, and returns the position of that. If none is found since (point-min), the function returns (point-min).

If the optional second argument LIMIT is non-nil, don't search past position LIMIT; return LIMIT if nothing is found before LIMIT. LIMIT is a no-op if it is less than (point-min).

(defun previous-char-property-change (position &optional limit))

Set one property of the text from START to END. The third and fourth arguments PROPERTY and VALUE specify the property to add. If the optional fifth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it.

(defun put-text-property (start end property value &optional object))

Remove some properties from text from START to END. The third argument PROPERTIES is a property list whose property names specify the properties to remove. (The values stored in PROPERTIES are ignored.) If the optional fourth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. Return t if any property was actually removed, nil otherwise.

Use `set-text-properties' if you want to remove all text properties.

(defun remove-text-properties (start end properties &optional object))

Return the value of POSITION's property PROP, in OBJECT. Both overlay properties and text properties are checked. OBJECT is optional and defaults to the current buffer. If POSITION is at the end of OBJECT, the value is nil. If OBJECT is a buffer, then overlay properties are considered as well as text properties. If OBJECT is a window, then that window's buffer is used, but window-specific overlays are considered only if they are associated with OBJECT.

(defun get-char-property (position prop &optional object))

Return the position of next text property or overlay change for a specific property. Scans characters forward from POSITION till it finds a change in the PROP property, then returns the position of the change. If the optional third argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it.

In a string, scan runs to the end of the string. In a buffer, it runs to (point-max), and the value cannot exceed that.

The property values are compared with `eq'. If the property is constant all the way to the end of OBJECT, return the last valid position in OBJECT. If the optional fourth argument LIMIT is non-nil, don't search past position LIMIT; return LIMIT if nothing is found before LIMIT.

(defun next-single-char-property-change (position prop &optional object limit))

Return the position of next property change for a specific property. Scans characters forward from POSITION till it finds a change in the PROP property, then returns the position of the change. If the optional third argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. The property values are compared with `eq'. Return nil if the property is constant all the way to the end of OBJECT. If the value is non-nil, it is a position greater than POSITION, never equal.

If the optional fourth argument LIMIT is non-nil, don't search past position LIMIT; return LIMIT if nothing is found before LIMIT.

(defun next-single-property-change (position prop &optional object limit)
  limit)

Return the value of POSITION's property PROP, in OBJECT. OBJECT is optional and defaults to the current buffer. If POSITION is at the end of OBJECT, the value is nil.

(defun get-text-property (position prop &optional object))

Return the list of properties of the character at POSITION in OBJECT. If the optional second argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. If POSITION is at the end of OBJECT, the value is nil.

(defun text-properties-at (position &optional object))

Completely replace properties of text from START to END. The third argument PROPERTIES is the new property list. If the optional fourth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. If PROPERTIES is nil, the effect is to remove all properties from the designated part of OBJECT.

(defun set-text-properties (start end properties &optional object))

Return the position of previous property change for a specific property. Scans characters backward from POSITION till it finds a change in the PROP property, then returns the position of the change. If the optional third argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. The property values are compared with `eq'. Return nil if the property is constant all the way to the start of OBJECT. If the value is non-nil, it is a position less than POSITION, never equal.

If the optional fourth argument LIMIT is non-nil, don't search back past position LIMIT; return LIMIT if nothing is found until LIMIT.

(defun previous-single-property-change (position prop &optional object limit))

Return the position of previous property change. Scans characters backwards from POSITION in OBJECT till it finds a change in some text property, then returns the position of the change. If the optional second argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. Return nil if the property is constant all the way to the start of OBJECT. If the value is non-nil, it is a position less than POSITION, never equal.

If the optional third argument LIMIT is non-nil, don't search back past position LIMIT; return LIMIT if nothing is found until LIMIT.

(defun previous-property-change (position &optional object limit))
 
(ns deuce.emacs.doc
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs-lisp :as el])
  (:refer-clojure :exclude []))

A list of files used to build this Emacs binary.

(defvar build-files nil)

Name of file containing documentation strings of built-in symbols.

(defvar internal-doc-file-name nil)

Used during Emacs initialization to scan the `etc/DOC...' file. This searches the `etc/DOC...' file for doc strings and records them in function and variable definitions. The function takes one argument, FILENAME, a string; it specifies the file name (without a directory) of the DOC file. That file is found in `../etc' now; later, when the dumped Emacs is run, the same file name is found in the `doc-directory'.

(defun Snarf-documentation (filename))

Substitute key descriptions for command names in STRING. Each substring of the form [COMMAND] is replaced by either a keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND is not on any keys.

Each substring of the form {MAPVAR} is replaced by a summary of the value of MAPVAR as a keymap. This summary is similar to the one produced by `describe-bindings'. The summary ends in two newlines (used by the helper function `help-make-xrefs' to find the end of the summary).

Each substring of the form \<MAPVAR> specifies the use of MAPVAR as the keymap for future [COMMAND] substrings. \= quotes the following character and is discarded; thus, \=\= puts \= into the output, and \=[ puts [ into the output.

Return the original STRING if no substitutions are made. Otherwise, return a new string, without any text properties.

(defun substitute-command-keys (string)
  "Substitute key descriptions for command names in STRING.
  Each substring of the form \\[COMMAND] is replaced by either a
  keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
  is not on any keys.
  Each substring of the form \\{MAPVAR} is replaced by a summary of
  the value of MAPVAR as a keymap.  This summary is similar to the one
  produced by `describe-bindings'.  The summary ends in two newlines
  (used by the helper function `help-make-xrefs' to find the end of the
  summary).
  Each substring of the form \\<MAPVAR> specifies the use of MAPVAR
  as the keymap for future \\[COMMAND] substrings.
  \\= quotes the following character and is discarded;
  thus, \\=\\= puts \\= into the output, and \\=\\[ puts \\[ into the output.
  Return the original STRING if no substitutions are made.
  Otherwise, return a new string, without any text properties."
  string)

Return the documentation string that is SYMBOL's PROP property. Third argument RAW omitted or nil means pass the result through `substitute-command-keys' if it is a string.

This differs from `get' in that it can refer to strings stored in the `etc/DOC' file; and that it evaluates documentation properties that aren't strings.

(defun documentation-property (symbol prop &optional raw))

Return the documentation string of FUNCTION. Unless a non-nil second argument RAW is given, the string is passed through `substitute-command-keys'.

(defun documentation (function &optional raw)
  (let [m (meta (el/fun function))]
    (str ((if raw identity substitute-command-keys) (:doc m))
         "\n\n"
         (cons 'fn (or (map #(% '#{&optional &rest}
                                (symbol (s/upper-case %)))
                            (:el-arglist m))
                       (first (:arglists m)))))))
 
(ns deuce.emacs.editfns
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.java.io :as io]
            [clojure.java.shell :as sh]
            [clojure.string :as s]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.casefiddle :as casefiddle]
            [deuce.emacs.data :as data]
            [deuce.emacs.terminal :as terminal]
            [deuce.emacs.window :as window]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.globals :as globals]
            [taoensso.timbre :as timbre])
  (:import [java.net InetAddress]
           [java.text SimpleDateFormat]
           [java.util Date Calendar TimeZone List]
           [java.lang.management ManagementFactory]
           [deuce.emacs.data Buffer BufferText Marker])
  (:refer-clojure :exclude [format]))

Property which (if non-nil) indicates text has been fontified. buffer-substring' need not call thebuffer-access-fontify-functions' functions if all the text being accessed has this property.

(defvar buffer-access-fontified-property nil)

The release of the operating system Emacs is running on.

(defvar operating-system-release (System/getProperty "os.version"))

The user's name, based upon the real uid only.

(defvar user-real-login-name (System/getProperty "user.name"))

List of functions called by `buffer-substring' to fontify if necessary. Each function is called with two arguments which specify the range of the buffer being accessed.

(defvar buffer-access-fontify-functions nil)

The user's name, taken from environment variables if possible.

(defvar user-login-name (System/getProperty "user.name"))

The host name of the machine Emacs is running on.

(defvar system-name (-> (sh/sh "hostname") :out s/trim))

Non-nil means text motion commands don't notice fields.

(defvar inhibit-field-text-motion nil)

The full name of the user logged in.

You can customize this variable.

(defvar user-full-name nil)
(defn ^:private move-marker [marker pt offset]
  (let [marker ^Marker marker]
    (when-let [pos @(.charpos marker)]
      (cond
        (and @(.insertion-type marker) (>= pos pt))
        (swap! (.charpos marker) + offset)
        (> pos pt)
        (swap! (.charpos marker) + offset)))
    marker))
(defn ^:private casefold [s]
  ((if (data/symbol-value 'case-fold-search) casefiddle/downcase identity) s))

Return the character position for byte position BYTEPOS. If BYTEPOS is out of range, the value is nil.

(defun byte-to-position (bytepos))

Return the contents of the field around POS, without text properties. A field is a region of text with the same `field' property. If POS is nil, the value of point is used for POS.

(defun field-string-no-properties (&optional pos))
(defn ^:private emacs-time-to-date [[high low usec]]
  (Date. (long (+ (* (+ (bit-shift-left high 16) low) 1000) (/ usec 1000)))))
(defn ^:private date-to-emacs-time [^Date date]
  (let [now (.getTime date)
        seconds (int (/ now 1000))]
    (list (bit-shift-right seconds 16) (bit-and 0xffff seconds) (* 1000 (mod now 1000)))))
(declare buffer-string buffer-substring buffer-size point mark-marker goto-char
         point-max point-min insert eobp bobp char-before message delete-region)

Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE). The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED), as from current-time' andfile-attributes', or nil to use the current time. The obsolete form (HIGH . LOW) is also still accepted. The list has the following nine members: SEC is an integer between 0 and 60; SEC is 60 for a leap second, which only some operating systems support. MINUTE is an integer between 0 and 59. HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31. MONTH is an integer between 1 and 12. YEAR is an integer indicating the four-digit year. DOW is the day of week, an integer between 0 and 6, where 0 is Sunday. DST is t if daylight saving time is in effect, otherwise nil. ZONE is an integer indicating the number of seconds east of Greenwich. (Note that Common Lisp has different meanings for DOW and ZONE.)

(defun decode-time (&optional specified-time))

Return the current time, as the number of seconds since 1970-01-01 00:00:00. The time is returned as a list of three integers. The first has the most significant 16 bits of the seconds, while the second has the least significant 16 bits. The third integer gives the microsecond count.

The microsecond count is zero on systems that do not provide resolution finer than a second.

(defun current-time ()
  (date-to-emacs-time (Date.)))

Return a marker to the maximum permissible value of point in this buffer. This is (1+ (buffer-size)), unless narrowing (a buffer restriction) is in effect, in which case it is less.

(defun point-max-marker ()
  ((ns-resolve 'deuce.emacs.buffer 'allocate-marker) nil (buffer/current-buffer) (point-max)))

Return the character preceding point, as a number. At the beginning of the buffer or accessible region, return 0.

(defun preceding-char ()
  (or (char-before) 0))

Internal use only. From START to END, translate characters according to TABLE. TABLE is a string or a char-table; the Nth character in it is the mapping for the character with code N. It returns the number of characters changed.

(defun translate-region-internal (start end table))

Insert text at point, relocating markers and inheriting properties. Point and markers move forward to end up after the inserted text.

If the current buffer is multibyte, unibyte strings are converted to multibyte for insertion (see `unibyte-char-to-multibyte'). If the current buffer is unibyte, multibyte strings are converted to unibyte for insertion.

(defun insert-before-markers-and-inherit (&rest args)
  (insert args))

Return the beginning of the field surrounding POS. A field is a region of text with the same `field' property. If POS is nil, the value of point is used for POS. If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its field, then the beginning of the previous field is returned. If LIMIT is non-nil, it is a buffer position; if the beginning of the field is before LIMIT, then LIMIT will be returned instead.

(defun field-beginning (&optional pos escape-from-edge limit))

Format a string out of a format-string and arguments. The first argument is a format control string. The other arguments are substituted into it to make the result, a string.

The format control string may contain %-sequences meaning to substitute the next available argument:

%s means print a string argument. Actually, prints any object, with `princ'. %d means print as number in decimal (%o octal, %x hex). %X is like %x, but uses upper case. %e means print a number in exponential notation. %f means print a number in decimal-point notation. %g means print a number in exponential notation or decimal-point notation, whichever uses fewer characters. %c means print a number as a single character. %S means print any object as an s-expression (using `prin1').

The argument used for %d, %o, %x, %e, %f, %g or %c must be a number. Use %% to put a single % into the output.

A %-sequence may contain optional flag, width, and precision specifiers, as follows:

%<flags><width><precision>character

where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+

The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only affect %d, %e, %f, and %g sequences, and the + flag takes precedence. The # flag means to use an alternate display form for %o, %x, %X, %e, %f, and %g sequences. The - and 0 flags affect the width specifier, as described below.

The width specifier supplies a lower limit for the length of the printed representation. The padding, if any, normally goes on the left, but it goes on the right if the - flag is present. The padding character is normally a space, but it is 0 if the 0 flag is present. The 0 flag is ignored if the - flag is present, or the format sequence is something other than %d, %e, %f, and %g.

For %e, %f, and %g sequences, the number after the "." in the precision specifier says how many decimal places to show; if zero, the decimal point itself is omitted. For %s and %S, the precision specifier truncates the string to the given width.

(defun format (string &rest objects)
  (apply c/format (s/replace string "%S" "%s")
         (map #(cond
                (and (instance? Long %)
                     (<= Integer/MIN_VALUE % Integer/MAX_VALUE)) (int %)
                     (instance? List %) (seq %)
                     :else %) objects)))

Return the effective uid of Emacs. Value is an integer or a float, depending on the value.

(defun user-uid ()
  (try
    (Integer/parseInt (s/trim (:out (sh/sh "id" "-u"))))
    (catch Exception _
      -1)))

Set the local time zone using TZ, a string specifying a time zone rule. If TZ is nil, use implementation-defined default time zone information. If TZ is t, use Universal Time.

Instead of calling this function, you typically want (setenv "TZ" TZ). That changes both the environment of the Emacs process and the variable process-environment', whereasset-time-zone-rule' affects only the former.

(defun set-time-zone-rule (tz))

Insert the arguments at point, inheriting properties from adjoining text. Point and before-insertion markers move forward to end up after the inserted text. Any other markers at the point of insertion remain before the text.

If the current buffer is multibyte, unibyte strings are converted to multibyte for insertion (see `unibyte-char-to-multibyte'). If the current buffer is unibyte, multibyte strings are converted to unibyte for insertion.

(defun insert-and-inherit (&rest args)
  (insert args))

Return the name of the user's real uid, as a string. This ignores the environment variables LOGNAME and USER, so it differs from user-login-name' when running undersu'.

(defun user-real-login-name ()
  (data/symbol-value 'user-real-login-name))

Return the process ID of Emacs, as an integer.

(defun emacs-pid ()
  (let [runtime-name (.getName (ManagementFactory/getRuntimeMXBean))]
    (if-let [[[_ pid]] (re-seq #"^(\d+)@\w+" runtime-name)]
      (Integer/parseInt pid)
      -1)))

Return the maximum permissible value of point in the current buffer. This is (1+ (buffer-size)), unless narrowing (a buffer restriction) is in effect, in which case it is less.

(defun point-max ()
  (if-let [zv @(.zv ^Buffer (buffer/current-buffer))]
    zv
    (inc (buffer-size))))

Return t if two characters match, optionally ignoring case. Both arguments must be characters (i.e. integers). Case is ignored if `case-fold-search' is non-nil in the current buffer.

(defun char-equal (c1 c2)
  (= (casefold c1) (casefold c2)))

Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. This is the reverse operation of `decode-time', which see. ZONE defaults to the current time zone rule. This can be a string or t (as from `set-time-zone-rule'), or it can be a list (as from current-time-zone') or an integer (as fromdecode-time') applied without consideration for daylight saving time.

You can pass more than 7 arguments; then the first six arguments are used as SECOND through YEAR, and the last argument is used as ZONE. The intervening arguments are ignored. This feature lets (apply 'encode-time (decode-time ...)) work.

Out-of-range values for SECOND, MINUTE, HOUR, DAY, or MONTH are allowed; for example, a DAY of 0 means the day preceding the given month. Year numbers less than 100 are treated just like other year numbers. If you want them to stand for years in this century, you must do that yourself.

Years before 1970 are not guaranteed to work. On some systems, year values as low as 1901 do work.

(defun encode-time (second minute hour day month year &optional zone))

Return character in current buffer at position POS. POS is an integer or a marker and defaults to point. If POS is out of range, the value is nil.

(defun char-after (&optional pos)
  (let [pos (dec (or pos (point)))]
    (when  (< -1 pos (buffer-size))
      (.charAt (str (buffer-string)) pos))))

Return the size of the current buffer's gap. See also `gap-position'.

(defun gap-size ())

Insert before point a substring of the contents of BUFFER. BUFFER may be a buffer or a buffer name. Arguments START and END are character positions specifying the substring. They default to the values of (point-min) and (point-max) in BUFFER.

(defun insert-buffer-substring (buffer &optional start end)
  (insert (binding [buffer/*current-buffer* buffer]
            (buffer-substring start end))))

Return a marker to the minimum permissible value of point in this buffer. This is the beginning, unless narrowing (a buffer restriction) is in effect.

(defun point-min-marker ()
  ((ns-resolve 'deuce.emacs.buffer 'allocate-marker) nil (buffer/current-buffer) (point-min)))

Return the first character in STRING.

(defun string-to-char (string)
  (first string))

Return value of point, as a marker object.

(defun point-marker ()
  ((ns-resolve 'deuce.emacs.buffer 'allocate-marker) nil (buffer/current-buffer) (point)))

Return the position of the gap, in the current buffer. See also `gap-size'.

(defun gap-position ())

Return t if point is at the end of a line. `End of a line' includes point being at the end of the buffer.

(defun eolp ()
  (or (eobp) (= \newline (char-after))))

Return the character position of the last character on the current line. With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position.

The returned position is of the last character in the logical order, i.e. the character whose buffer position is the largest one.

This function constrains the returned position to the current field unless that would be on a different line than the original, unconstrained result. If N is nil or 1, and a rear-sticky field ends at point, the scan stops as soon as it starts. To ignore field boundaries bind `inhibit-field-text-motion' to t.

This function does not move point.

(defun line-end-position (&optional n)
  ;; This should be defined the other way around.
  (let [pt (point)]
    (try
      ((el/fun 'end-of-line) n)
      (finally (goto-char pt)))))

Restrict editing in this buffer to the current region. The rest of the text becomes temporarily invisible and untouchable but is not deleted; if you save the buffer in a file, the invisible text is included in the file. C-x n w makes all visible again. See also `save-restriction'.

When calling from a program, pass two arguments; positions (integers or markers) bounding the text that should remain visible.

(defun narrow-to-region (start end)
  (interactive "r")
  (let [buffer ^Buffer (buffer/current-buffer)]
    (reset! (.begv buffer) start)
    (reset! (.zv buffer) end)))

Return the current run time used by Emacs. The time is returned as a list of three integers. The first has the most significant 16 bits of the seconds, while the second has the least significant 16 bits. The third integer gives the microsecond count.

On systems that can't determine the run time, `get-internal-run-time' does the same thing as `current-time'. The microsecond count is zero on systems that do not provide resolution finer than a second.

(defun get-internal-run-time ()
  (current-time))

Return the minimum permissible value of point in the current buffer. This is 1, unless narrowing (a buffer restriction) is in effect.

(defun point-min ()
  (if-let [begv @(.begv ^Buffer (buffer/current-buffer))]
    begv
    1))

Remove restrictions (narrowing) from current buffer. This allows the buffer's full text to be seen and edited.

(defun widen ()
  (interactive)
  (let [buffer ^Buffer (buffer/current-buffer)]
    (reset! (.begv buffer) nil)
    (reset! (.zv buffer) nil)))

From START to END, replace FROMCHAR with TOCHAR each time it occurs. If optional arg NOUNDO is non-nil, don't record this change for undo and don't mark the buffer as really changed. Both characters must have the same length of multi-byte form.

(defun subst-char-in-region (start end fromchar tochar &optional noundo)
  (let [text ^BufferText (.text ^Buffer (buffer/current-buffer))]
    (.replace ^StringBuilder (.beg text)
              (int start) (int end)
              (s/replace (buffer-substring start end) fromchar tochar))
    (reset! (.modiff text) (System/currentTimeMillis))
    nil))

Return t if point is at the beginning of a line.

(defun bolp ()
  (or (bobp) (= \newline (char-before))))

Return the byte position for character position POSITION. If POSITION is out of range, the value is nil.

(defun position-bytes (position)
  (point))

Return value of point, as an integer. Beginning of buffer is position (point-min).

(defun point ()
  @(.pt ^Buffer (buffer/current-buffer)))

Return the contents of the field surrounding POS as a string. A field is a region of text with the same `field' property. If POS is nil, the value of point is used for POS.

(defun field-string (&optional pos))

Return the integer value of point or mark, whichever is smaller.

(defun region-beginning ()
  (min @(.charpos ^Marker (mark-marker)) (point)))

Return the character position of the first character on the current line. With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position.

The returned position is of the first character in the logical order, i.e. the one that has the smallest character position.

This function constrains the returned position to the current field unless that would be on a different line than the original, unconstrained result. If N is nil or 1, and a front-sticky field starts at point, the scan stops as soon as it starts. To ignore field boundaries bind `inhibit-field-text-motion' to t.

This function does not move point.

(defun line-beginning-position (&optional n)
  ;; This should be defined the other way around.
  (let [pt (point)]
    (try
      ((el/fun 'beginning-of-line) n)
      (finally (goto-char pt)))))

Return the character following point, as a number. At the end of the buffer or accessible region, return 0.

(defun following-char ()
  (or (char-after) 0))

Return t if point is at the end of the buffer. If the buffer is narrowed, this means the end of the narrowed part.

(defun eobp ()
  (= (point) (point-max)))

Return the characters of part of the buffer, without the text properties. The two arguments START and END are character positions; they can be in either order.

(defun buffer-substring-no-properties (start end)
  (buffer-substring start end))

Return the real uid of Emacs. Value is an integer or a float, depending on the value.

(defun user-real-uid ()
  (user-uid))

Return the end of the field surrounding POS. A field is a region of text with the same `field' property. If POS is nil, the value of point is used for POS. If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field, then the end of the following field is returned. If LIMIT is non-nil, it is a buffer position; if the end of the field is after LIMIT, then LIMIT will be returned instead.

(defun field-end (&optional pos escape-from-edge limit))

Return the name under which the user logged in, as a string. This is based on the effective uid, not the real uid. Also, if the environment variables LOGNAME or USER are set, that determines the value of this function.

If optional argument UID is an integer or a float, return the login name of the user with that uid, or nil if there is no such user.

(defun user-login-name (&optional uid)
  (data/symbol-value 'user-login-name))

Return t if point is at the beginning of the buffer. If the buffer is narrowed, this means the beginning of the narrowed part.

(defun bobp ()
  (= (point-min) (point)))

Display a message in a dialog box or in the echo area. If this command was invoked with the mouse, use a dialog box if `use-dialog-box' is non-nil. Otherwise, use the echo area. The first argument is a format control string, and the rest are data to be formatted under control of the string. See `format' for details.

If the first argument is nil or the empty string, clear any existing message; let the minibuffer contents show.

(defun message-or-box (format-string &rest args)
  (message format-string args))

Return a copy of STRING with text properties added. First argument is the string to copy. Remaining arguments form a sequence of PROPERTY VALUE pairs for text properties to add to the result.

(defun propertize (string &rest properties)
  string)

Return the current local time, as a human-readable string. Programs can use this function to decode a time, since the number of columns in each field is fixed if the year is in the range 1000-9999. The format is `Sun Sep 16 01:03:52 1973'. However, see also the functions decode-time' andformat-time-string' which provide a much more powerful and general facility.

If SPECIFIED-TIME is given, it is a time to format instead of the current time. The argument should have the form (HIGH LOW . IGNORED). Thus, you can use times obtained from `current-time' and from `file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW), but this is considered obsolete.

(defun current-time-string (&optional specified-time)
  (.format (SimpleDateFormat. "EEE MMM dd HH:mm:ss yyyy")
           (emacs-time-to-date (or specified-time (current-time)))))

Return the position closest to NEW-POS that is in the same field as OLD-POS. A field is a region of text with the same `field' property.

If NEW-POS is nil, then use the current point instead, and move point to the resulting constrained position, in addition to returning that position.

If OLD-POS is at the boundary of two fields, then the allowable positions for NEW-POS depends on the value of the optional argument ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is constrained to the field that has the same `field' char-property as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE is non-nil, NEW-POS is constrained to the union of the two adjacent fields. Additionally, if two fields are separated by another field with the special value `boundary', then any point within this special field is also considered to be `on the boundary'.

If the optional argument ONLY-IN-LINE is non-nil and constraining NEW-POS would move it to a different line, NEW-POS is returned unconstrained. This useful for commands that move by line, like C-n or M-x beginning-of-line, which should generally respect field boundaries only in the case where they can still move to the right line.

If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has a non-nil property of that name, then any field boundaries are ignored.

Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.

(defun constrain-to-field (new-pos old-pos &optional escape-from-edge only-in-line inhibit-capture-property)
  ;; This a vast simplification
  (if new-pos
    new-pos
    (goto-char (point))))

Return the contents of the current buffer as a string. If narrowing is in effect, this function returns only the visible part of the buffer.

(defun buffer-string ()
  (buffer-substring (point-min) (point-max)))

Return the string currently displayed in the echo area, or nil if none.

(defun current-message ()
  ;; Not sure when and why it uses " *Echo Area 1*"
  (binding [buffer/*current-buffer* (buffer/get-buffer-create " *Echo Area 0*")]
    (buffer-string)))

Delete the field surrounding POS. A field is a region of text with the same `field' property. If POS is nil, the value of point is used for POS.

(defun delete-field (&optional pos))

Delete the text between START and END and return it.

(defun delete-and-extract-region (start end)
  (let [deleted (buffer-substring start end)]
    (delete-region start end)
    deleted))

Return the offset and name for the local time zone. This returns a list of the form (OFFSET NAME). OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). A negative value means west of Greenwich. NAME is a string giving the name of the time zone. If SPECIFIED-TIME is given, the time zone offset is determined from it instead of using the current time. The argument should have the form (HIGH LOW . IGNORED). Thus, you can use times obtained from current-time' and fromfile-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW), but this is considered obsolete.

Some operating systems cannot provide all this information to Emacs; in this case, `current-time-zone' returns a list containing nil for the data it can't find.

(defun current-time-zone (&optional specified-time)
  (let [^Date specified-time (if specified-time
                               (emacs-time-to-date specified-time)
                               (Date.))
        timezone (.getTimeZone (doto (Calendar/getInstance)
                                 (.setTime specified-time)))]
    (list (/ (.getOffset timezone (.getTime specified-time)) 1000)
          (.getDisplayName timezone (.inDaylightTime timezone specified-time) TimeZone/SHORT))))

Insert strings or characters at point, relocating markers after the text. Point and markers move forward to end up after the inserted text.

If the current buffer is multibyte, unibyte strings are converted to multibyte for insertion (see `unibyte-char-to-multibyte'). If the current buffer is unibyte, multibyte strings are converted to unibyte for insertion.

(defun insert-before-markers (&rest args)
  (insert args))

Return character in current buffer preceding position POS. POS is an integer or a marker and defaults to point. If POS is out of range, the value is nil.

(defun char-before (&optional pos)
  (let [pos (- (or pos (point)) 2)]
    (when (< -1 pos (buffer-size))
      (.charAt (str (buffer-string)) pos))))

Convert arg CHAR to a string containing that character.

(defun char-to-string (char)
  (str (c/char char)))

Delete the text between START and END. If called interactively, delete the region between point and mark. This command deletes buffer text without modifying the kill ring.

(defun delete-region (start end)
  (interactive "r")
  (let [buffer ^Buffer (buffer/current-buffer)
        text ^BufferText (.text buffer)]
    (.delete ^StringBuilder (.beg text) (int (dec start)) (int (dec end)))
    (reset! (.modiff text) (System/currentTimeMillis))
    (when-not (some #{@(.mark buffer)} @(.markers text))
      (swap! (.mark buffer) #(move-marker % start (- start end))))
    (swap! (.markers text) #(doall (map (fn [m] (move-marker m start (- start end))) %)))
    (when (> (point) start)
      (goto-char start)
      nil)))

Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2. The regions should not be overlapping, because the size of the buffer is never changed in a transposition.

Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update any markers that happen to be located in the regions.

Transposing beyond buffer boundaries is an error.

(defun transpose-regions (startr1 endr1 startr2 endr2 &optional leave-markers)
  (let [r1 (buffer-substring startr1 endr1)
        r2 (buffer-substring startr2 endr2)
        pt (point)
        buffer ^Buffer (buffer/current-buffer)
        text ^BufferText (.text buffer)
        mark @(.mark buffer)
        markers @(.markers text)]
    (delete-region startr1 endr1)
    (goto-char startr1)
    (insert r2)
    (delete-region startr2 endr2)
    (goto-char startr2)
    (insert r1)
    (when leave-markers
      (reset! (.mark buffer) mark)
      (reset! (.markers text) markers))
    (goto-char pt)))

Set point to POSITION, a number or marker. Beginning of buffer is position (point-min), end is (point-max).

The return value is POSITION.

(defun goto-char (position)
  (interactive "NGoto char: ")
  (el/check-type 'integer-or-marker-p position)
  (let [position (if (data/markerp position) @(.charpos ^Marker position) position)
        real-pos (min (max (point-min) position) (point-max))]
    (reset! (.pt ^Buffer (buffer/current-buffer)) real-pos)
    position))

Insert COUNT copies of CHARACTER. Point, and before-insertion markers, are relocated as in the function `insert'. The optional third arg INHERIT, if non-nil, says to inherit text properties from adjoining text, if those properties are sticky.

(defun insert-char (character count &optional inherit)
  (insert (apply str (repeat count character))))

Return the host name of the machine you are running on, as a string.

(defun system-name ()
  (data/symbol-value 'system-name))

Return the number of characters in the current buffer. If BUFFER, return the number of characters in that buffer instead.

(defun buffer-size (&optional buffer)
  (count (.beg ^BufferText (.text ^Buffer (el/check-type 'bufferp (or buffer (buffer/current-buffer)))))))

Return the integer value of point or mark, whichever is larger.

(defun region-end ()
  (max @(.charpos ^Marker (mark-marker)) (point)))

Use FORMAT-STRING to format the time TIME, or now if omitted. TIME is specified as (HIGH LOW . IGNORED), as returned by current-time' orfile-attributes'. The obsolete form (HIGH . LOW) is also still accepted. The third, optional, argument UNIVERSAL, if non-nil, means describe TIME as Universal Time; nil means describe TIME in the local time zone. The value is a copy of FORMAT-STRING, but with certain constructs replaced by text that describes the specified date and time in TIME:

%Y is the year, %y within the century, %C the century. %G is the year corresponding to the ISO week, %g within the century. %m is the numeric month. %b and %h are the locale's abbreviated month name, %B the full name. %d is the day of the month, zero-padded, %e is blank-padded. %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. %a is the locale's abbreviated name of the day of week, %A the full name. %U is the week number starting on Sunday, %W starting on Monday, %V according to ISO 8601. %j is the day of the year.

%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H only blank-padded, %l is like %I blank-padded. %p is the locale's equivalent of either AM or PM. %M is the minute. %S is the second. %N is the nanosecond, %6N the microsecond, %3N the millisecond, etc. %Z is the time zone name, %z is the numeric form. %s is the number of seconds since 1970-01-01 00:00:00 +0000.

%c is the locale's date and time format. %x is the locale's "preferred" date format. %D is like "%m/%d/%y".

%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p". %X is the locale's "preferred" time format.

Finally, %n is a newline, %t is a tab, %% is a literal %.

Certain flags and modifiers are available with some format controls. The flags are _',-', ^' and#'. For certain characters X, %_X is like %X, but padded with blanks; %-X is like %X, but without padding. %^X is like %X, but with all textual characters up-cased; %#X is like %X, but with letter-case of all textual characters reversed. %NX (where N stands for an integer) is like %X, but takes up at least N (a number) positions. The modifiers are E' andO'. For certain characters X, %EX is a locale's alternative version of %X; %OX is like %X, but uses the locale's number symbols.

For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".

(defun format-time-string (format-string &optional time universal)
  (let [[hi low] (or time (current-time))
        time (long (* (+ (bit-shift-left hi 16) low) 1000))]
    (.format (SimpleDateFormat. (reduce #(apply s/replace %1 %2) format-string
                                        {"%Y" "Y"
                                         "%m" "MM"
                                         "%d" "dd"})) (Date. time))))

Insert COUNT (second arg) copies of BYTE (first arg). Both arguments are required. BYTE is a number of the range 0..255.

If BYTE is 128..255 and the current buffer is multibyte, the corresponding eight-bit character is inserted.

Point, and before-insertion markers, are relocated as in the function `insert'. The optional third arg INHERIT, if non-nil, says to inherit text properties from adjoining text, if those properties are sticky.

(defun insert-byte (byte count &optional inherit)
  (insert-char (char byte) count inherit))

Compare two substrings of two buffers; return result as number. the value is -N if first string is less after N-1 chars, +N if first string is greater after N-1 chars, or 0 if strings match. Each substring is represented as three arguments: BUFFER, START and END. That makes six args in all, three for each substring.

The value of `case-fold-search' in the current buffer determines whether case is significant or ignored.

(defun compare-buffer-substrings (buffer1 start1 end1 buffer2 start2 end2)
  (let [s1 (binding [buffer/*current-buffer* buffer1]
             (buffer-substring start1 end1))
        s2 (binding [buffer/*current-buffer* buffer2]
             (buffer-substring start2 end2))]
    (compare (casefold s1) (casefold s2))))

Return this buffer's mark, as a marker object. Watch out! Moving this marker changes the mark position. If you set the marker not to point anywhere, the buffer will have no mark.

(defun mark-marker ()
  @(.mark ^Buffer (buffer/current-buffer)))

Return the full name of the user logged in, as a string. If the full name corresponding to Emacs's userid is not known, return "unknown".

If optional argument UID is an integer or float, return the full name of the user with that uid, or nil if there is no such user. If UID is a string, return the full name of the user with that login name, or nil if there is no such user.

(defun user-full-name (&optional uid))

Display a message at the bottom of the screen. The message also goes into the `Messages' buffer. (In keyboard macros, that's all it does.) Return the message.

The first argument is a format control string, and the rest are data to be formatted under control of the string. See `format' for details.

Note: Use (message "%s" VALUE) to print the value of expressions and variables to avoid accidentally interpreting `%' as format specifiers.

If the first argument is nil or the empty string, the function clears any existing message; this lets the minibuffer contents show. See also `current-message'.

(defun message (format-string &rest args)
  ;; The echo area buffers are called " *Echo Area %d*". They share window with the minibuffer.
  ;; Note the leading space for minibuffer window buffers.
  ;; Need to pick the right ones here instead of just 0.
  ;; Part of this is duplicated in deuce.emacs.lread/echo, consolidate when we know more.
  (let [message (when message (apply format format-string args))
        echo-area (buffer/get-buffer-create " *Echo Area 0*")
        minibuffer (buffer/get-buffer-create " *Minibuf-0*")]
    (if (seq message)
      (do
        (timbre/info message)
        (binding [buffer/*current-buffer* (buffer/get-buffer-create "*Messages*")]
          (insert (str message \newline))) ;; Emacs has logic to figure out if newline is needed.
        (binding [buffer/*current-buffer* echo-area]
          (buffer/erase-buffer)
          (insert message))
        (window/set-window-buffer (window/minibuffer-window) echo-area)
        ;; This will go away
        (when-not (terminal/frame-terminal)
          (println message)))
      (do
        (binding [buffer/*current-buffer* echo-area]
          (buffer/erase-buffer))
        (window/set-window-buffer (window/minibuffer-window) minibuffer)))))

Insert the arguments, either strings or characters, at point. Point and before-insertion markers move forward to end up after the inserted text. Any other markers at the point of insertion remain before the text.

If the current buffer is multibyte, unibyte strings are converted to multibyte for insertion (see `string-make-multibyte'). If the current buffer is unibyte, multibyte strings are converted to unibyte for insertion (see `string-make-unibyte').

When operating on binary data, it may be necessary to preserve the original bytes of a unibyte string when inserting it into a multibyte buffer; to accomplish this, apply `string-as-multibyte' to the string and insert the result.

(defun insert (&rest args)
  (let [string (str (apply str args))
        buffer ^Buffer (buffer/current-buffer)
        pt @(.pt buffer)
        text ^BufferText (.text buffer)]
    (.insert ^StringBuilder (.beg text) (int (dec pt)) string)
    (reset! (.modiff text) (System/currentTimeMillis))
    (when-not (some #{@(.mark buffer)} @(.markers text))
      (swap! (.mark buffer) #(move-marker % pt (count string))))
    (swap! (.markers text) #(doall (map (fn [m] (move-marker m pt (count string))) %)))
    (goto-char (+ pt (count string))))
  nil)

Return the contents of part of the current buffer as a string. The two arguments START and END are character positions; they can be in either order. The string returned is multibyte if the buffer is multibyte.

This function copies the text properties of that part of the buffer into the result string; if you don't want the text properties, use `buffer-substring-no-properties' instead.

(defun buffer-substring (start end)
  (subs (str (.beg ^BufferText (.text ^Buffer (buffer/current-buffer)))) (dec start) (dec end)))

Convert arg BYTE to a unibyte string containing that byte.

(defun byte-to-string (byte)
  (str (char byte)))

Return the current time, as a float number of seconds since the epoch. If SPECIFIED-TIME is given, it is the time to convert to float instead of the current time. The argument should have the form (HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from current-time' and fromfile-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW), but this is considered obsolete.

WARNING: Since the result is floating point, it may not be exact. If precise time stamps are required, use either `current-time', or (if you need time as a string) `format-time-string'.

(defun float-time (&optional specified-time)
  (let [^Date specified-time (if specified-time
                               (emacs-time-to-date specified-time)
                               (Date.))]
    (/ (.getTime specified-time) 1000.0)))

Display a message, in a dialog box if possible. If a dialog box is not available, use the echo area. The first argument is a format control string, and the rest are data to be formatted under control of the string. See `format' for details.

If the first argument is nil or the empty string, clear any existing message; let the minibuffer contents show.

(defun message-box (format-string &rest args)
  (message format-string args))
 
(ns deuce.emacs.minibuf
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.cons :refer [car] :as cons]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.fns :as fns]
            [deuce.emacs.window :as window])
  (:refer-clojure :exclude [read-string]))

History list symbol to add minibuffer values to. Each string of minibuffer input, as it appears on exit from the minibuffer, is added with (set minibuffer-history-variable (cons STRING (symbol-value minibuffer-history-variable)))

(defvar minibuffer-history-variable nil)

A history list for arguments that are Lisp expressions to evaluate. For example, `eval-expression' uses this.

(defvar read-expression-history nil)

List of regexps that should restrict possible completions. The basic completion functions only consider a completion acceptable if it matches all regular expressions in this list, with case-fold-search' bound to the value ofcompletion-ignore-case'. See Info node `(elisp)Basic Completion', for a description of these functions.

(defvar completion-regexp-list nil)

Normal hook run just after exit from minibuffer.

(defvar minibuffer-exit-hook nil)

Non-nil means completing file names.

(defvar minibuffer-completing-file-name nil)

Non-nil means to allow minibuffer commands while in the minibuffer. This variable makes a difference whenever the minibuffer window is active.

You can customize this variable.

(defvar enable-recursive-minibuffers nil)

Normal hook run just after entry to minibuffer.

(defvar minibuffer-setup-hook nil)

Text properties that are added to minibuffer prompts. These are in addition to the basic `field' property, and stickiness properties.

You can customize this variable.

(defvar minibuffer-prompt-properties nil)

Non-nil means completion ignores case when reading a buffer name.

You can customize this variable.

(defvar read-buffer-completion-ignore-case nil)

Current position of redoing in the history list.

(defvar minibuffer-history-position nil)

If this is non-nil, `read-buffer' does its work by calling this function. The function is called with the arguments passed to `read-buffer'.

You can customize this variable.

(defvar read-buffer-function nil)

Non-nil means to delete duplicates in history. If set to t when adding a new history element, all previous identical elements are deleted from the history list.

You can customize this variable.

(defvar history-delete-duplicates nil)

Within call to `completing-read', this holds the PREDICATE argument.

(defvar minibuffer-completion-predicate nil)

Non-nil means don't consider case significant in completion. For file-name completion, `read-file-name-completion-ignore-case' controls the behavior, rather than this variable. For buffer name completion, `read-buffer-completion-ignore-case' controls the behavior, rather than this variable.

(defvar completion-ignore-case nil)

Value that `help-form' takes on inside the minibuffer.

(defvar minibuffer-help-form nil)

Non-nil means `read-from-minibuffer' should not discard text properties. This also affects read-string', but it does not affectread-minibuffer', `read-no-blanks-input', or any of the functions that do minibuffer input with completion; they always discard text properties.

(defvar minibuffer-allow-text-properties nil)

Minibuffer keymap used for reading Lisp expressions.

(defvar read-expression-map nil)

Maximum length of history lists before truncation takes place. A number means truncate to that length; truncation deletes old elements, and is done just after inserting a new element. A value of t means no truncation.

This variable only affects history lists that don't specify their own maximum lengths. Setting the `history-length' property of a history variable overrides this default.

You can customize this variable.

(defvar history-length nil)

Non-nil means entering the minibuffer raises the minibuffer's frame. Some uses of the echo area also raise that frame (since they use it too).

You can customize this variable.

(defvar minibuffer-auto-raise nil)

Alist or obarray used for completion in the minibuffer. This becomes the ALIST argument to try-completion' andall-completions'. The value can also be a list of strings or a hash table.

The value may alternatively be a function, which is given three arguments: STRING, the current buffer contents; PREDICATE, the predicate for filtering possible matches; CODE, which says what kind of things to do. CODE can be nil, t or `lambda': nil -- return the best completion of STRING, or nil if there is none. t -- return a list of all possible completions of STRING. lambda -- return t if STRING is a valid completion as it stands.

(defvar minibuffer-completion-table nil)

Non-nil means to add new elements in history. If set to nil, minibuffer reading functions don't add new elements to the history list, so it is possible to do this afterwards by calling `add-to-history' explicitly.

(defvar history-add-new-input nil)

Whether to demand confirmation of completion before exiting minibuffer. If nil, confirmation is not required. If the value is `confirm', the user may exit with an input that is not a valid completion alternative, but Emacs asks for confirmation. If the value is `confirm-after-completion', the user may exit with an input that is not a valid completion alternative, but Emacs asks for confirmation if the user submitted the input right after any of the completion commands listed in `minibuffer-confirm-exit-commands'.

(defvar minibuffer-completion-confirm nil)
(declare filter-completions active-minibuffer-window)
(def ^:private minibuf-prompt (atom nil))

Return current depth of activations of minibuffer, a nonnegative integer.

(defun minibuffer-depth ()
  (if (active-minibuffer-window) 1 0))
(defn ^:private minibuffer [prompt & [default]]
  (let [minibuffer (buffer/get-buffer-create " *Minibuf-1*")]
    (binding [buffer/*current-buffer* minibuffer]
      (buffer/erase-buffer)
      (when (seq prompt)
        (editfns/insert prompt))
      (when default
        (editfns/insert (if (data/listp default) (data/car default) default))))
    (reset! minibuf-prompt prompt)
    (window/set-window-buffer (window/minibuffer-window) minibuffer)
    (window/select-window (window/minibuffer-window))))

Return non-nil if STRING is a valid completion. Takes the same arguments as all-completions' andtry-completion'. If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'.

(defun test-completion (string collection &optional predicate)
  (when (some #{string} (filter-completions collection predicate))
    true))

Read a string in the minibuffer, with completion. PROMPT is a string to prompt with; normally it ends in a colon and a space. COLLECTION can be a list of strings, an alist, an obarray or a hash table. COLLECTION can also be a function to do the completion itself. PREDICATE limits completion to a subset of COLLECTION. See try-completion' andall-completions' for more details on completion, COLLECTION, and PREDICATE.

REQUIRE-MATCH can take the following values: - t means that the user is not allowed to exit unless the input is (or completes to) an element of COLLECTION or is null. - nil means that the user can exit with any input. - `confirm' means that the user can exit with any input, but she needs to confirm her choice if the input is not an element of COLLECTION. - `confirm-after-completion' means that the user can exit with any input, but she needs to confirm her choice if she called minibuffer-complete' right beforeminibuffer-complete-and-exit' and the input is not an element of COLLECTION. - anything else behaves like t except that typing RET does not exit if it does non-null completion.

If the input is null, `completing-read' returns DEF, or the first element of the list of default values, or an empty string if DEF is nil, regardless of the value of REQUIRE-MATCH.

If INITIAL-INPUT is non-nil, insert it in the minibuffer initially, with point positioned at the end. If it is (STRING . POSITION), the initial input is STRING, but point is placed at zero-indexed position POSITION in STRING. (Note that this is different from `read-from-minibuffer' and related functions, which use one-indexing for POSITION.) This feature is deprecated--it is best to pass nil for INITIAL-INPUT and supply the default value DEF instead. The user can yank the default value into the minibuffer easily using M-x next-history-element.

HIST, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable to use, and HISTPOS is the initial position (the position in the list used by the minibuffer history commands). For consistency, you should also specify that element of the history as the value of INITIAL-INPUT. (This is the only case in which you should use INITIAL-INPUT instead of DEF.) Positions are counted starting from 1 at the beginning of the list. The variable `history-length' controls the maximum length of a history list.

DEF, if non-nil, is the default value or the list of default values.

If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits the current input method and the setting of `enable-multibyte-characters'.

Completion ignores case if the ambient value of `completion-ignore-case' is non-nil.

See also `completing-read-function'.

(defun completing-read (prompt collection &optional predicate require-match initial-input hist def inherit-input-method)
  (minibuffer prompt))

Read a string from the minibuffer, prompting with string PROMPT. The optional second arg INITIAL-CONTENTS is an obsolete alternative to DEFAULT-VALUE. It normally should be nil in new code, except when HIST is a cons. It is discussed in more detail below.

Third arg KEYMAP is a keymap to use whilst reading; if omitted or nil, the default is `minibuffer-local-map'.

If fourth arg READ is non-nil, interpret the result as a Lisp object and return that object: in other words, do `(car (read-from-string INPUT-STRING))'

Fifth arg HIST, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list variable to use, or a cons cell (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable to use, and HISTPOS is the initial position for use by the minibuffer history commands. For consistency, you should also specify that element of the history as the value of INITIAL-CONTENTS. Positions are counted starting from 1 at the beginning of the list.

Sixth arg DEFAULT-VALUE, if non-nil, should be a string, which is used as the default to `read' if READ is non-nil and the user enters empty input. But if READ is nil, this function does not return DEFAULT-VALUE for empty input! Instead, it returns the empty string.

Whatever the value of READ, DEFAULT-VALUE is made available via the
minibuffer history commands.  DEFAULT-VALUE can also be a list of
strings, in which case all the strings are available in the history,
and the first string is the default to `read' if READ is non-nil.

Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits the current input method and the setting of `enable-multibyte-characters'.

If the variable `minibuffer-allow-text-properties' is non-nil, then the string which is returned includes whatever text properties were present in the minibuffer. Otherwise the value has no text properties.

The remainder of this documentation string describes the INITIAL-CONTENTS argument in more detail. It is only relevant when studying existing code, or when HIST is a cons. If non-nil, INITIAL-CONTENTS is a string to be inserted into the minibuffer before reading input. Normally, point is put at the end of that string. However, if INITIAL-CONTENTS is (STRING . POSITION), the initial input is STRING, but point is placed at one-indexed position POSITION in the minibuffer. Any integer value less than or equal to one puts point at the beginning of the string. Note that this behavior differs from the way such arguments are used in `completing-read' and some related functions, which use zero-indexing for POSITION.

(defun read-from-minibuffer (prompt &optional initial-contents keymap read hist default-value inherit-input-method))

Like `assoc' but specifically for strings (and symbols).

This returns the first element of LIST whose car matches the string or symbol KEY, or nil if no match exists. When performing the comparison, symbols are first converted to strings, and unibyte strings to multibyte. If the optional arg CASE-FOLD is non-nil, case is ignored.

Unlike `assoc', KEY can also match an entry in LIST consisting of a single string, rather than a cons cell whose car is a string.

(defun assoc-string (key list &optional case-fold)
  (some #(and (if (data/consp %)
                (fns/equal key (str (car %)))
                (fns/equal key %)) %) (seq list)))

Read a string from the terminal, not allowing blanks. Prompt with PROMPT. Whitespace terminates the input. If INITIAL is non-nil, it should be a string, which is used as initial input, with point positioned at the end, so that SPACE will accept the input. (Actually, INITIAL can also be a cons of a string and an integer. Such values are treated as in `read-from-minibuffer', but are normally not useful in this function.) Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits the current input method and the setting of`enable-multibyte-characters'.

(defun read-no-blanks-input (prompt &optional initial inherit-input-method))

Return the prompt string of the currently-active minibuffer. If no minibuffer is active, return nil.

(defun minibuffer-prompt ()
  @minibuf-prompt)

Read the name of a command and return as a symbol. Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element if it is a list.

(defun read-command (prompt &optional default-value)
  (minibuffer prompt default-value))
(defn ^:private filter-completions [collection predicate]
  (map #(if (data/consp %) (car %) %)
       (filter (if predicate (el/fun predicate) identity) collection)))
(defn ^:private try-completion-internal [string collection]
  (when-let [completions (seq (filter #(.startsWith (str %) ^String string) collection))]
    (reduce #(loop [n (count %1)]
               (let [prefix (subs %1 0 n)]
                 (if (.startsWith ^String %2 prefix) prefix (recur (dec n)))))
            (sort completions))))

Return common substring of all completions of STRING in COLLECTION. Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, see `symbol-name'. All that match STRING are compared together; the longest initial sequence common to all these matches is the return value. If there is no match at all, the return value is nil. For a unique match which is exact, the return value is t.

If COLLECTION is an alist, the keys (cars of elements) are the possible completions. If an element is not a cons cell, then the element itself is the possible completion. If COLLECTION is a hash-table, all the keys that are strings or symbols are the possible completions. If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions.

COLLECTION can also be a function to do the completion itself. It receives three arguments: the values STRING, PREDICATE and nil. Whatever it returns becomes the value of `try-completion'.

If optional third argument PREDICATE is non-nil, it is used to test each possible match. The match is a candidate only if PREDICATE returns non-nil. The argument given to PREDICATE is the alist element or the symbol from the obarray. If COLLECTION is a hash-table, predicate is called with two arguments: the key and the value. Additionally to this predicate, `completion-regexp-list' is used to further constrain the set of candidates.

(defun try-completion (string collection &optional predicate)
  (let [collection (filter-completions collection predicate)]
    (when-let [completion (try-completion-internal string collection)]
      (if (= 1 (count (filter #{string} collection)))
        true
        completion))))

Return value of Lisp expression read using the minibuffer. Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert in the minibuffer before reading. (INITIAL-CONTENTS can also be a cons of a string and an integer. Such arguments are used as in `read-from-minibuffer'.)

(defun eval-minibuffer (prompt &optional initial-contents))

Read a string from the minibuffer, prompting with string PROMPT. If non-nil, second arg INITIAL-INPUT is a string to insert before reading. This argument has been superseded by DEFAULT-VALUE and should normally be nil in new code. It behaves as in `read-from-minibuffer'. See the documentation string of that function for details. The third arg HISTORY, if non-nil, specifies a history list and optionally the initial position in the list. See `read-from-minibuffer' for details of HISTORY argument. Fourth arg DEFAULT-VALUE is the default value or the list of default values. If non-nil, it is used for history commands, and as the value (or the first element of the list of default values) to return if the user enters the empty string. Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits the current input method and the setting of `enable-multibyte-characters'.

(defun read-string (prompt &optional initial-input history default-value inherit-input-method))

Return the buffer position of the end of the minibuffer prompt. Return (point-min) if current buffer is not a minibuffer.

(defun minibuffer-prompt-end ()
  (if (active-minibuffer-window)
    (inc (count @minibuf-prompt))
    (editfns/point-min)))

Specify which minibuffer window to use for the minibuffer. This affects where the minibuffer is displayed if you put text in it without invoking the usual minibuffer commands.

(defun set-minibuffer-window (window))

Return t if BUFFER is a minibuffer. No argument or nil as argument means use current buffer as BUFFER. BUFFER can be a buffer or a buffer name.

(defun minibufferp (&optional buffer)
  (when (re-find #" *Minibuf-\d+" (buffer/buffer-name buffer))
    true))

Perform completion on buffer names. If the argument FLAG is nil, invoke `try-completion', if it's t, invoke all-completions', otherwise invoketest-completion'.

The arguments STRING and PREDICATE are as in `try-completion', all-completions', andtest-completion'.

(defun internal-complete-buffer (string predicate flag))

Search for partial matches to STRING in COLLECTION. Test each of the possible completions specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, see `symbol-name'. The value is a list of all the possible completions that match STRING.

If COLLECTION is an alist, the keys (cars of elements) are the possible completions. If an element is not a cons cell, then the element itself is the possible completion. If COLLECTION is a hash-table, all the keys that are strings or symbols are the possible completions. If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions.

COLLECTION can also be a function to do the completion itself. It receives three arguments: the values STRING, PREDICATE and t. Whatever it returns becomes the value of `all-completions'.

If optional third argument PREDICATE is non-nil, it is used to test each possible match. The match is a candidate only if PREDICATE returns non-nil. The argument given to PREDICATE is the alist element or the symbol from the obarray. If COLLECTION is a hash-table, predicate is called with two arguments: the key and the value. Additionally to this predicate, `completion-regexp-list' is used to further constrain the set of candidates.

An obsolete optional fourth argument HIDE-SPACES is still accepted for backward compatibility. If non-nil, strings in COLLECTION that start with a space are ignored unless STRING itself starts with a space.

(defun all-completions (string collection &optional predicate)
  (let [collection (filter-completions collection predicate)
        prefix (try-completion-internal string collection)]
    (apply alloc/list (filter #(.startsWith (str %) prefix) collection))))

Read the name of a buffer and return as a string. Prompt with PROMPT. Optional second arg DEF is value to return if user enters an empty line. If DEF is a list of default values, return its first element. Optional third arg REQUIRE-MATCH determines whether non-existing buffer names are allowed. It has the same meaning as the REQUIRE-MATCH argument of `completing-read'. The argument PROMPT should be a string ending with a colon and a space. If `read-buffer-completion-ignore-case' is non-nil, completion ignores case while reading the buffer name. If `read-buffer-function' is non-nil, this works by calling it as a function, instead of the usual behavior.

(defun read-buffer (prompt &optional def require-match))

Return a Lisp object read using the minibuffer, unevaluated. Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert in the minibuffer before reading. (INITIAL-CONTENTS can also be a cons of a string and an integer. Such arguments are used as in `read-from-minibuffer'.)

(defun read-minibuffer (prompt &optional initial-contents))

Return the user input in a minibuffer as a string, without text-properties. If the current buffer is not a minibuffer, return its entire contents.

(defun minibuffer-contents-no-properties ()
  (editfns/buffer-string))

Return the user input in a minibuffer as a string. If the current buffer is not a minibuffer, return its entire contents.

(defun minibuffer-contents ()
  (subs (editfns/buffer-string) (count @minibuf-prompt)))

Read the name of a user variable and return it as a symbol. Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element if it is a list. A user variable is one for which `user-variable-p' returns non-nil.

(defun read-variable (prompt &optional default-value))

Return the currently active minibuffer window, or nil if none.

(defun active-minibuffer-window ()
  (when (= (window/selected-window) (window/minibuffer-window))
    (window/minibuffer-window)))
 
(ns deuce.emacs.menu
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Pop up a deck-of-cards menu and return user's selection. POSITION is a position specification. This is either a mouse button event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET are positions in pixels from the top left corner of WINDOW. (WINDOW may be a window or a frame object.) This controls the position of the top left of the menu as a whole. If POSITION is t, it means to use the current mouse position.

MENU is a specifier for a menu. For the simplest case, MENU is a keymap. The menu items come from key bindings that have a menu string as well as a definition; actually, the "definition" in such a key binding looks like (STRING . REAL-DEFINITION). To give the menu a title, put a string into the keymap as a top-level element.

If REAL-DEFINITION is nil, that puts a nonselectable string in the menu. Otherwise, REAL-DEFINITION should be a valid key binding definition.

You can also use a list of keymaps as MENU. Then each keymap makes a separate pane.

When MENU is a keymap or a list of keymaps, the return value is the list of events corresponding to the user's choice. Note that `x-popup-menu' does not actually execute the command bound to that sequence of events.

Alternatively, you can specify a menu of multiple panes with a list of the form (TITLE PANE1 PANE2...), where each pane is a list of form (TITLE ITEM1 ITEM2...). Each ITEM is normally a cons cell (STRING . VALUE); but a string can appear as an item--that makes a nonselectable line in the menu. With this form of menu, the return value is VALUE from the chosen item.

If POSITION is nil, don't display the menu at all, just precalculate the cached information about equivalent key sequences.

If the user gets rid of the menu without making a valid choice, for instance by clicking the mouse away from a valid choice or by typing keyboard input, then this normally results in a quit and `x-popup-menu' does not return. But if POSITION is a mouse button event (indicating that the user invoked the menu with the mouse) then no quit occurs and `x-popup-menu' returns nil.

(defun x-popup-menu (position menu))
 
(ns deuce.emacs.fileio
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [clojure.java.io :as io]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.editfns :as editfns])
  (:import [java.nio.file Files LinkOption
            NoSuchFileException]
           [deuce.emacs.data Buffer BufferText])
  (:refer-clojure :exclude []))

*Coding system for encoding file names. If it is nil, `default-file-name-coding-system' (which see) is used.

(defvar file-name-coding-system nil)

If non-nil, a function to call to decide a coding system of file. Two arguments are passed to this function: the file name and the length of a file contents following the point. This function should return a coding system to decode the file contents. It should check the file name against `auto-coding-alist'. If no coding system is decided, it should check a coding system specified in the heading lines with the format: -- ... coding: CODING-SYSTEM; ... -- or local variable spec of the tailing lines with `coding:' tag.

(defvar set-auto-coding-function nil)

Specifies whether to use the system's trash can. When non-nil, certain file deletion commands use the function `move-file-to-trash' instead of deleting files outright. This includes interactive calls to `delete-file' and `delete-directory' and the Dired deletion commands.

You can customize this variable.

(defvar delete-by-moving-to-trash nil)

File name in which we write a list of all auto save file names. This variable is initialized automatically from `auto-save-list-file-prefix' shortly after Emacs reads your `.emacs' file, if you have not yet given it a non-nil value.

(defvar auto-save-list-file-name nil)

Default coding system for encoding file names. This variable is used only when `file-name-coding-system' is nil.

This variable is set/changed by the command `set-language-environment'. User should not set this variable manually, instead use `file-name-coding-system' to get a constant encoding of file names regardless of the current language environment.

(defvar default-file-name-coding-system nil)

When an annotation function is called, this holds the previous annotations. These are the annotations made by other annotation functions that were already called. See also `write-region-annotate-functions'.

(defvar write-region-annotations-so-far nil)

The operation for which `inhibit-file-name-handlers' is applicable.

(defvar inhibit-file-name-operation nil)

*Non-nil means don't call fsync in `write-region'. This variable affects calls to `write-region' as well as save commands. A non-nil value may result in data loss!

(defvar write-region-inhibit-fsync nil)

Non-nil says auto-save a buffer in the file it is visiting, when practical. Normally auto-save files are written under other names.

You can customize this variable.

(defvar auto-save-visited-file-name nil)

A list of functions to be called at the start of `write-region'. Each is passed two arguments, START and END as for `write-region'. These are usually two numbers but not always; see the documentation for `write-region'. The function should return a list of pairs of the form (POSITION . STRING), consisting of strings to be effectively inserted at the specified positions of the file being written (1 means to insert before the first byte written). The POSITIONs must be sorted into increasing order.

If there are several annotation functions, the lists returned by these functions are merged destructively. As each annotation function runs, the variable `write-region-annotations-so-far' contains a list of all annotations returned by previous annotation functions.

An annotation function can return with a different buffer current. Doing so removes the annotations returned by previous functions, and resets START and END to point-min' andpoint-max' of the new buffer.

After `write-region' completes, Emacs calls the function stored in `write-region-post-annotation-function', once for each buffer that was current when building the annotations (i.e., at least once), with that buffer current.

(defvar write-region-annotate-functions nil)

Alist of elements (REGEXP . HANDLER) for file names handled specially. If a file name matches REGEXP, all I/O on that file is done by calling HANDLER. If a file name matches more than one handler, the handler whose match starts last in the file name gets precedence. The function `find-file-name-handler' checks this list for a handler for its argument.

HANDLER should be a function. The first argument given to it is the name of the I/O primitive to be handled; the remaining arguments are the arguments that were passed to that primitive. For example, if you do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then HANDLER is called like this:

(funcall HANDLER 'file-exists-p FILENAME)

Note that HANDLER must be able to handle all I/O primitives; if it has nothing special to do for a primitive, it should reinvoke the primitive to handle the operation "the usual way". See Info node `(elisp)Magic File Names' for more details.

(defvar file-name-handler-alist nil)

If non-nil, auto-save even if a large part of the text is deleted. If nil, deleting a substantial portion of the text disables auto-save in the buffer; this is the default behavior, because the auto-save file is usually more useful if it contains the deleted text.

(defvar auto-save-include-big-deletions nil)

A list of functions to be called at the end of `insert-file-contents'. Each is passed one argument, the number of characters inserted, with point at the start of the inserted text. Each function should leave point the same, and return the new character count. If `insert-file-contents' is intercepted by a handler from `file-name-handler-alist', that handler is responsible for calling the functions in `after-insert-file-functions' if appropriate.

(defvar after-insert-file-functions nil)

A list of file name handlers that temporarily should not be used. This applies only to the operation `inhibit-file-name-operation'.

(defvar inhibit-file-name-handlers nil)

Function to call after `write-region' completes. The function is called with no arguments. If one or more of the annotation functions in `write-region-annotate-functions' changed the current buffer, the function stored in this variable is called for each of those additional buffers as well, in addition to the original buffer. The relevant buffer is current during each function call.

(defvar write-region-post-annotation-function nil)
(declare expand-file-name file-name-as-directory)

Clear any record of a recent auto-save failure in the current buffer.

(defun clear-buffer-auto-save-failure ())

Return t if file FILENAME specifies an absolute file name. On Unix, this is a name starting with a /' or a~'.

(defun file-name-absolute-p (filename)
  (el/check-type 'stringp filename)
  (when (re-find #"^[/~]" filename)
    true))

Update buffer's recorded modification time from the visited file's time. Useful if the buffer was not read from the file normally or if the file itself has been changed for some known benign reason. An argument specifies the modification time value to use (instead of that of the visited file), in the form of a list (HIGH . LOW) or (HIGH LOW).

(defun set-visited-file-modtime (&optional time-list))

Set the file permission bits for newly created files. The argument MODE should be an integer; only the low 9 bits are used. This setting is inherited by subprocesses.

(defun set-default-file-modes (mode))

Return t if file FILENAME can be written or created by you.

(defun file-writable-p (filename)
  (el/check-type 'stringp filename)
  (Files/isWritable (.toPath (io/file (expand-file-name filename)))))

Return t if (car A) is numerically less than (car B).

(defun car-less-than-car (a b))

Convert filename NAME to absolute, and canonicalize it. Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative (does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing, the current buffer's value of `default-directory' is used. NAME should be a string that is a valid file name for the underlying filesystem. File name components that are `.' are removed, and so are file name components followed by ..', along with the..' itself; note that these simplifications are done without checking the resulting file names in the file system. Multiple consecutive slashes are collapsed into a single slash, except at the beginning of the file name when they are significant (e.g., UNC file names on MS-Windows.) An initial `~/' expands to your home directory. An initial `~USER/' expands to USER's home directory. See also the function `substitute-in-file-name'.

For technical reasons, this function can return correct but non-intuitive results for the root directory; for instance, (expand-file-name ".." "/") returns "/..". For this reason, use (directory-file-name (file-name-directory dirname)) to traverse a filesystem tree, not (expand-file-name ".." dirname).

(defun expand-file-name (name &optional default-directory)
  (el/check-type 'stringp name)
  (let [directory (or default-directory (data/symbol-value 'default-directory))]
    (if-let [resource (io/resource (str (file-name-as-directory directory) name))]
      (.getPath resource)
      (let [home (file-name-as-directory (System/getProperty "user.home"))
            file (io/file (s/replace name #"^~" home))
            file (if (.isAbsolute file)
                   file
                   (io/file directory name))]
        (if-not (.exists file) ;; Assume its classpath relative dir.
          (str (file-name-as-directory directory) name)
          (.getCanonicalPath file))))))

Write current region into specified file. When called from a program, requires three arguments: START, END and FILENAME. START and END are normally buffer positions specifying the part of the buffer to write. If START is nil, that means to use the entire buffer contents. If START is a string, then output that string to the file instead of any buffer contents; END is ignored.

Optional fourth argument APPEND if non-nil means append to existing file contents (if any). If it is an integer, seek to that offset in the file before writing. Optional fifth argument VISIT, if t or a string, means set the last-save-file-modtime of buffer to this file's modtime and mark buffer not modified. If VISIT is a string, it is a second file name; the output goes to FILENAME, but the buffer is marked as visiting VISIT. VISIT is also the file name to lock and unlock for clash detection. If VISIT is neither t nor nil nor a string, that means do not display the "Wrote file" message. The optional sixth arg LOCKNAME, if non-nil, specifies the name to use for locking and unlocking, overriding FILENAME and VISIT. The optional seventh arg MUSTBENEW, if non-nil, insists on a check for an existing file with the same name. If MUSTBENEW is `excl', that means to get an error if the file already exists; never overwrite. If MUSTBENEW is neither nil nor `excl', that means ask for confirmation before overwriting, but do go ahead and overwrite the file if the user confirms.

This does code conversion according to the value of coding-system-for-write',buffer-file-coding-system', or `file-coding-system-alist', and sets the variable `last-coding-system-used' to the coding system actually used.

This calls `write-region-annotate-functions' at the start, and `write-region-post-annotation-function' at the end.

(defun write-region (start end filename &optional append visit lockname mustbenew)
  (interactive "r\nFWrite region to file: \ni\ni\ni\np"))

Return t if file FILENAME exists (whether or not you can read it.) See also file-readable-p' andfile-attributes'. This returns nil for a symlink to a nonexistent file. Use `file-symlink-p' to test for such links.

(defun file-exists-p (filename)
  (.exists (io/file (expand-file-name filename))))

Set SELinux context of file named FILENAME to CONTEXT. CONTEXT should be a list (USER ROLE TYPE RANGE), where the list elements are strings naming the components of a SELinux context.

This function does nothing if SELinux is disabled, or if Emacs was not compiled with SELinux support.

(defun set-file-selinux-context (filename context))

Auto-save all buffers that need it. This is all buffers that have auto-saving enabled and are changed since last auto-saved. Auto-saving writes the buffer into a file so that your editing is not lost if the system crashes. This file is not the file you visited; that changes only when you save. Normally we run the normal hook `auto-save-hook' before saving.

A non-nil NO-MESSAGE argument means do not print any message if successful. A non-nil CURRENT-ONLY argument means save only current buffer.

(defun do-auto-save (&optional no-message current-only)
  (interactive))

Return SELinux context of file named FILENAME. The return value is a list (USER ROLE TYPE RANGE), where the list elements are strings naming the user, role, type, and range of the file's SELinux security context.

Return (nil nil nil nil) if the file is nonexistent or inaccessible, or if SELinux is disabled, or if Emacs lacks SELinux support.

(defun file-selinux-context (filename))

Delete the directory named DIRECTORY. Does not follow symlinks.

(defun delete-directory-internal (directory))

Return FILENAME's handler function for OPERATION, if it has one. Otherwise, return nil. A file name is handled if one of the regular expressions in `file-name-handler-alist' matches it.

If OPERATION equals `inhibit-file-name-operation', then we ignore any handlers that are members of `inhibit-file-name-handlers', but we still do run any other handlers. This lets handlers use the standard functions without calling themselves recursively.

(defun find-file-name-handler (filename operation))

Rename FILE as NEWNAME. Both args must be strings. If file has names other than FILE, it continues to have those names. Signals a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. A number as third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x.

(defun rename-file (file newname &optional ok-if-already-exists)
  (interactive "fRename file: \nGRename %s to file: \np"))

Make a symbolic link to FILENAME, named LINKNAME. Both args must be strings. Signals a `file-already-exists' error if a file LINKNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. A number as third arg means request confirmation if LINKNAME already exists. This happens for interactive use with M-x.

(defun make-symbolic-link (filename linkname &optional ok-if-already-exists)
  (interactive "FMake symbolic link to file: \nGMake symbolic link to file %s: \np"))

Return the default file protection for created files. The value is an integer.

(defun default-file-modes ())

Clear out records of last mod time of visited file. Next attempt to save will certainly not complain of a discrepancy.

(defun clear-visited-file-modtime ())

Return the current buffer's recorded visited file modification time. The value is a list of the form (HIGH LOW), like the time values that `file-attributes' returns. If the current buffer has no recorded file modification time, this function returns 0. If the visited file doesn't exist, HIGH will be -1. See Info node `(elisp)Modification Time' for more details.

(defun visited-file-modtime ())

Tell Unix to finish all pending disk updates.

(defun unix-sync ()
  (interactive))

Return t if last mod time of BUF's visited file matches what BUF records. This means that the file has not been changed since it was visited or saved. If BUF is omitted or nil, it defaults to the current buffer. See Info node `(elisp)Modification Time' for more details.

(defun verify-visited-file-modtime (&optional buf))

Returns the file name of the directory named DIRECTORY. This is the name of the file that holds the data for the directory DIRECTORY. This operation exists because a directory is also a file, but its name as a directory is different from its name as a file. In Unix-syntax, this function just removes the final slash.

(defun directory-file-name (directory)
  (el/check-type 'stringp directory)
  (if (= "/" directory)
    directory
    (if (re-find #"/$" directory)
      (subs directory 0 (dec (count directory)))
      directory)))

Create a new directory named DIRECTORY.

(defun make-directory-internal (directory))

Return t if file FILE1 is newer than file FILE2. If FILE1 does not exist, the answer is nil; otherwise, if FILE2 does not exist, the answer is t.

(defun file-newer-than-file-p (file1 file2))

Return t if file FILENAME exists and you can read it. See also file-exists-p' andfile-attributes'.

(defun file-readable-p (filename)
  (el/check-type 'stringp filename)
  (Files/isReadable (.toPath (io/file (expand-file-name filename)))))

Delete file named FILENAME. If it is a symlink, remove the symlink. If file has multiple names, it continues to exist with the other names. TRASH non-nil means to trash the file instead of deleting, provided `delete-by-moving-to-trash' is non-nil.

When called interactively, TRASH is t if no prefix argument is given. With a prefix argument, TRASH is nil.

(defun delete-file (filename &optional trash)
  (interactive "(list (read-file-name (if (and delete-by-moving-to-trash (null current-prefix-arg)) \"Move file to trash: \" \"Delete file: \") nil default-directory (confirm-nonexistent-file-or-buffer)) (null current-prefix-arg))"))

Return t if FILENAME can be executed by you. For a directory, this means you can access files in that directory.

(defun file-executable-p (filename)
  (el/check-type 'stringp filename)
  (Files/isExecutable (.toPath (io/file (expand-file-name filename)))))

Generate temporary file name (string) starting with PREFIX (a string). The Emacs process number forms part of the result, so there is no danger of generating a name being used by another process.

In addition, this function makes an attempt to choose a name which has no existing file. To make this work, PREFIX should be an absolute file name.

There is a race condition between calling `make-temp-name' and creating the file which opens all kinds of security holes. For that reason, you should probably use `make-temp-file' instead, except in three circumstances:

  • If you are creating the file in the user's home directory.
  • If you are creating a directory rather than an ordinary file.
  • If you are taking special precautions as `make-temp-file' does.
(defun make-temp-name (prefix))

Access file FILENAME, and get an error if that does not work. The second argument STRING is used in the error message. If there is no error, returns nil.

(defun access-file (filename string))

Give FILE additional name NEWNAME. Both args must be strings. Signals a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. A number as third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x.

(defun add-name-to-file (file newname &optional ok-if-already-exists)
  (interactive "fAdd name to file: \nGName to add to %s: \np"))

Return t if current buffer has been auto-saved recently. More precisely, if it has been auto-saved since last read from or saved in the visited file. If the buffer has no visited file, then any auto-save counts as "recent".

(defun recent-auto-save-p ())

Insert contents of file FILENAME after point. Returns list of absolute file name and number of characters inserted. If second argument VISIT is non-nil, the buffer's visited filename and last save file modtime are set, and it is marked unmodified. If visiting and the file does not exist, visiting is completed before the error is signaled.

The optional third and fourth arguments BEG and END specify what portion of the file to insert. These arguments count bytes in the file, not characters in the buffer. If VISIT is non-nil, BEG and END must be nil.

If optional fifth argument REPLACE is non-nil, replace the current buffer contents (in the accessible portion) with the file contents. This is better than simply deleting and inserting the whole thing because (1) it preserves some marker positions and (2) it puts less data in the undo list. When REPLACE is non-nil, the second return value is the number of characters that replace previous buffer contents.

This function does code conversion according to the value of coding-system-for-read' orfile-coding-system-alist', and sets the variable `last-coding-system-used' to the coding system actually used.

(defun insert-file-contents (filename &optional visit beg end replace)
  (let [file (let [file (io/file (expand-file-name filename))]
               (if (.exists file)
                 (.toURL file)
                 (io/resource filename)))
        contents (slurp file)
        contents (if (and visit beg end)
                   (subs contents beg end)
                   contents)
        path (.getPath file)
        point (editfns/point)]
    (editfns/insert contents)
    (when visit
      (reset! (.save-modiff ^BufferText (.text ^Buffer (buffer/current-buffer))) (System/currentTimeMillis))
      ;; These vars are buffer local.
      (el/setq buffer-file-name path)
      (el/setq buffer-file-truename filename) ; Might be correct, should be result of files/file-truename.
      (el/setq buffer-saved-size (count contents)))
    (doseq [f (data/symbol-value 'after-insert-file-functions)]
      (editfns/goto-char 1)
      (eval/funcall f (count contents)))
    (editfns/goto-char point)
    (list path (count contents))))

Return file name FILENAME sans its directory. For example, in a Unix-syntax file name, this is everything after the last slash, or the entire name if it contains no slash.

(defun file-name-nondirectory (filename)
  (el/check-type 'stringp filename)
  (if (re-find #"/$" filename)
    ""
    (.getName (io/file filename))))

Substitute environment variables referred to in FILENAME. `$FOO' where FOO is an environment variable name means to substitute the value of that variable. The variable name should be terminated with a character not a letter, digit or underscore; otherwise, enclose the entire variable name in braces.

If /~' appears, all of FILENAME through that/' is discarded. If `//' appears, everything up to and including the first of those `/' is discarded.

(defun substitute-in-file-name (filename)
  (let [filename (-> filename
                     (s/replace #".+(~/.+)" "$1")
                     (s/replace #".+/(/.+)" "$1"))
        vars (re-seq #"\$(\w+|\{.+\})" filename)]
    (reduce #(s/replace %1 (first %2) (System/getenv (second %2))) filename vars)))

Return t if FILENAME names an existing directory. Symbolic links to directories count as directories. See `file-symlink-p' to distinguish symlinks.

(defun file-directory-p (filename)
  (el/check-type 'stringp filename)
  (.isDirectory (io/file (expand-file-name filename))))

Mark current buffer as auto-saved with its current text. No auto-save file will be written until the buffer changes again.

(defun set-buffer-auto-saved ())

Set times of file FILENAME to TIMESTAMP. Set both access and modification times. Return t on success, else nil. Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of `current-time'.

(defun set-file-times (filename &optional timestamp))

Set mode bits of file named FILENAME to MODE (an integer). Only the 12 low bits of MODE are used.

Interactively, mode bits are read by `read-file-modes', which accepts symbolic notation, like the `chmod' command from GNU Coreutils.

(defun set-file-modes (filename mode)
  (interactive "(let ((file (read-file-name \"File: \"))) (list file (read-file-modes nil file)))"))

Return t if file FILENAME names a directory you can open. For the value to be t, FILENAME must specify the name of a directory as a file, and the directory must allow you to open files in it. In order to use a directory as a buffer's current directory, this predicate must return true. A directory name spec may be given instead; then the value is t if the directory so specified exists and really is a readable and searchable directory.

(defun file-accessible-directory-p (filename)
  (el/check-type 'stringp filename)
  (file-directory-p filename))

Return a string representing the file name FILE interpreted as a directory. This operation exists because a directory is also a file, but its name as a directory is different from its name as a file. The result can be used as the value of `default-directory' or passed as second argument to `expand-file-name'. For a Unix-syntax file name, just appends a slash.

(defun file-name-as-directory (file)
  (el/check-type 'stringp file)
  (if (re-find #"/$" file)
    file
    (str file "/")))

Copy FILE to NEWNAME. Both args must be strings. If NEWNAME names a directory, copy FILE there.

This function always sets the file modes of the output file to match the input file.

The optional third argument OK-IF-ALREADY-EXISTS specifies what to do if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we signal a `file-already-exists' error without overwriting. If OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user about overwriting; this is what happens in interactive use with M-x. Any other value for OK-IF-ALREADY-EXISTS means to overwrite the existing file.

Fourth arg KEEP-TIME non-nil means give the output file the same last-modified time as the old one. (This works on only some systems.)

A prefix arg makes KEEP-TIME non-nil.

If PRESERVE-UID-GID is non-nil, we try to transfer the uid and gid of FILE to NEWNAME.

If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled on the system, we copy the SELinux context of FILE to NEWNAME.

(defun copy-file (file newname &optional ok-if-already-exists keep-time preserve-uid-gid preserve-selinux-context)
  (interactive "fCopy file: \nGCopy %s to file: \np\nP"))

Return t if FILENAME names a regular file. This is the sort of file that holds an ordinary stream of data bytes. Symbolic links to regular files count as regular files. See `file-symlink-p' to distinguish symlinks.

(defun file-regular-p (filename)
  (el/check-type 'stringp filename)
  (Files/isRegularFile (.toPath (io/file (expand-file-name filename))) (make-array LinkOption 0)))

Return the directory component in file name FILENAME. Return nil if FILENAME does not include a directory. Otherwise return a directory name. Given a Unix syntax file name, returns a string ending in slash.

(defun file-name-directory (filename)
  (el/check-type 'stringp filename)
  (if (re-find #"/$" filename)
    filename
    (when-let [parent (and (seq filename)
                           (.getParent (if-let [resource (io/resource filename)]
                                         (io/file (.getFile resource)) ;; Terrible hack, reason is lread/locate-file-internal
                                         (io/file filename))))]
      (file-name-as-directory parent))))

Return non-nil if file FILENAME is the name of a symbolic link. The value is the link target, as a string. Otherwise it returns nil.

This function returns t when given the name of a symlink that points to a nonexistent file.

(defun file-symlink-p (filename)
  (el/check-type 'stringp filename)
  (let [path (.toPath (io/file (expand-file-name filename)))]
    (when (Files/isSymbolicLink path)
      (try
        (str (.toRealPath path (make-array LinkOption 0)))
        (catch NoSuchFileException _
          true)))))

Return a directly usable directory name somehow associated with FILENAME. A `directly usable' directory name is one that may be used without the intervention of any file handler. If FILENAME is a directly usable file itself, return (file-name-directory FILENAME). If FILENAME refers to a file which is not accessible from a local process, then this should return nil. The call-process' andstart-process' functions use this function to get a current directory to run processes in.

(defun unhandled-file-name-directory (filename))

Return mode bits of file named FILENAME, as an integer. Return nil, if file does not exist or is not accessible.

(defun file-modes (filename))

Return t if a call to `read-file-name' will use a dialog. The return value is only relevant for a call to `read-file-name' that happens before any other event (mouse or keypress) is handled.

(defun next-read-file-uses-dialog-p ())
 
(ns deuce.emacs.window
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.frame :as frame]
            [deuce.emacs-lisp.cons :as cons])
  (:import [deuce.emacs.data Buffer Frame Window Marker])
  (:refer-clojure :exclude []))

If t, splitting a window makes a new parent window. If this variable is nil, splitting a window will create a new parent window only if the window has no parent window or the window shall become a combination orthogonal to the one it is part of.

If this variable is t, splitting a window always creates a new parent window. If all splits behave this way, each frame's window tree is a binary tree and every window but the frame's root window has exactly one sibling.

Other values are reserved for future use.

The value of this variable is also assigned to the combination limit of the new parent window. The combination limit of a window can be retrieved via the function `window-combination-limit' and altered by the function `set-window-combination-limit'.

You can customize this variable.

(defvar window-combination-limit nil)

Functions to call when window configuration changes. The buffer-local part is run once per window, with the relevant window selected; while the global part is run only once for the modified frame, with the relevant frame selected.

(defvar window-configuration-change-hook nil)

If non-nil, this is a buffer and C-M-v should scroll its window.

(defvar other-window-scroll-buffer nil)

Alist of persistent window parameters. This alist specifies which window parameters shall get saved by current-window-configuration' andwindow-state-get' and subsequently restored to their previous values by `set-window-configuration' and `window-state-put'.

The car of each entry of this alist is the symbol specifying the parameter. The cdr is one of the following:

nil means the parameter is neither saved by `window-state-get' nor by `current-window-configuration'.

t means the parameter is saved by `current-window-configuration' and, provided its WRITABLE argument is nil, by `window-state-get'.

The symbol `writable' means the parameter is saved unconditionally by both current-window-configuration' andwindow-state-get'. Do not use this value for parameters without read syntax (like windows or frames).

Parameters not saved by `current-window-configuration' or window-state-get' are left alone byset-window-configuration' respectively are not installed by `window-state-put'.

(defvar window-persistent-parameters '((clone-of . true)))

Non-nil means it is the window that C-M-v in minibuffer should scroll.

(defvar minibuffer-scroll-window nil)

Non-nil means to automatically adjust `window-vscroll' to view tall lines.

(defvar auto-window-vscroll true)

Non-nil means to use `mode-line-inactive' face in non-selected windows. If the minibuffer is active, the `minibuffer-scroll-window' mode line is displayed in the `mode-line' face.

You can customize this variable.

(defvar mode-line-in-non-selected-windows true)

Non-nil means call as function to display a help buffer. The function is called with one argument, the buffer to be displayed. Used by `with-output-to-temp-buffer'. If this function is used, then it must do the entire job of showing the buffer; `temp-buffer-show-hook' is not run unless this function runs it.

You can customize this variable.

(defvar temp-buffer-show-function nil)

Number of lines of continuity when scrolling by screenfuls.

You can customize this variable.

(defvar next-screen-context-lines 2)

Type of marker to use for `window-point'.

(defvar window-point-insertion-type nil)

Non-nil means `recenter' redraws entire frame. If this option is non-nil, then the `recenter' command with a nil argument will redraw the entire frame; the special value `tty' causes the frame to be redrawn only if it is a tty frame.

You can customize this variable.

(defvar recenter-redisplay 'tty)

Controls if scroll commands move point to keep its screen position unchanged. A value of nil means point does not keep its screen position except at the scroll margin or window boundary respectively. A value of t means point keeps its screen position if the scroll command moved it vertically out of the window, e.g. when scrolling by full screens. Any other value means point always keeps its screen position. Scroll commands should have the `scroll-command' property on their symbols to be controlled by this variable.

You can customize this variable.

(defvar scroll-preserve-screen-position nil)

If t, resize window combinations proportionally. If this variable is nil, splitting a window gets the entire screen space for displaying the new window from the window to split. Deleting and resizing a window preferably resizes one adjacent window only.

If this variable is t, splitting a window tries to get the space proportionally from all windows in the same combination. This also allows to split a window that is otherwise too small or of fixed size. Resizing and deleting a window proportionally resize all windows in the same combination.

Other values are reserved for future use.

This variable takes no effect if `window-combination-limit' is non-nil.

You can customize this variable.

(defvar window-combination-resize nil)
(declare windowp window-minibuffer-p window-frame selected-window window-buffer)
(def ^:private sequence-number (atom 0))
(def ^:private window-prev-buffers-list (atom {}))
(def ^:private window-next-buffers-list (atom {}))
(defn ^:private allocate-window [minibuffer? parent leftcol top-line total-cols total-lines]
  (let [[next prev hchild vchild
         buffer start pointm] (repeatedly #(atom nil))
         normal-lines (atom 1.0)
         normal-cols (atom 1.0)]
    (Window. minibuffer? next prev hchild vchild (atom parent)
             (atom leftcol) (atom top-line) (atom total-lines) (atom total-cols)
             normal-lines normal-cols buffer start pointm (swap! sequence-number inc))))

Return t if OBJECT is a live window and nil otherwise. A live window is a window that displays a buffer. Internal windows and deleted windows are not live.

(defun window-live-p (object)
  (and (windowp object) @(.buffer ^Window object)))

Return combination limit of window WINDOW. If the return value is nil, child windows of WINDOW can be recombined with WINDOW's siblings. A return value of t means that child windows of WINDOW are never (re-)combined with WINDOW's siblings.

(defun window-combination-limit (window))

Return the total width, in columns, of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window.

The return value includes any vertical dividers or scroll bars belonging to WINDOW. If WINDOW is an internal window, the total width is the width of the screen areas spanned by its children.

On a graphical display, this total width is reported as an integer multiple of the default character width.

(defun window-total-width (&optional window)
  @(.total-cols ^Window (el/check-type 'windowp (or window (selected-window)))))

Return the normal height of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. If HORIZONTAL is non-nil, return the normal width of WINDOW.

(defun window-normal-size (&optional window horizontal)
  @(.normal-lines ^Window (el/check-type 'windowp (or window (selected-window)))))

Scroll next window upward ARG lines; or near full screen if no ARG. A near full screen is `next-screen-context-lines' less than a full screen. The next window is the one below the current one; or the one at the top if the current one is at the bottom. Negative ARG means scroll downward. If ARG is the atom `-', scroll downward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'.

If `other-window-scroll-buffer' is non-nil, scroll the window showing that buffer, popping the buffer up if necessary. If in the minibuffer, `minibuffer-scroll-window' if non-nil specifies the window to scroll. This takes precedence over `other-window-scroll-buffer'.

(defun scroll-other-window (&optional arg)
  (interactive "P"))

Return a list of the edge pixel coordinates of WINDOW's text area. The list has the form (LEFT TOP RIGHT BOTTOM), all relative to (0,0) at the top left corner of the frame's window area.

RIGHT is one more than the rightmost x position of WINDOW's text area. BOTTOM is one more than the bottommost y position of WINDOW's text area. The inside edges do not include the space used by WINDOW's scroll bar, display margins, fringes, header line, and/or mode line.

(defun window-inside-absolute-pixel-edges (&optional window))

Set number of columns WINDOW is scrolled from left margin to NCOL. If WINDOW is nil, the selected window is used. Return NCOL. NCOL should be zero or positive.

Note that if `automatic-hscrolling' is non-nil, you cannot scroll the window so that the location of point moves off-window.

(defun set-window-hscroll (window ncol)
  ncol)

Center point in selected window and maybe redisplay frame. With prefix argument ARG, recenter putting point on screen line ARG relative to the selected window. If ARG is negative, it counts up from the bottom of the window. (ARG should be less than the height of the window.)

If ARG is omitted or nil, then recenter with point on the middle line of the selected window; if the variable `recenter-redisplay' is non-nil, also erase the entire frame and redraw it (when `auto-resize-tool-bars' is set to `grow-only', this resets the tool-bar's height to the minimum height needed); if recenter-redisplay' has the special valuetty', then only tty frames are redrawn.

Just C-u as prefix means put point in the center of the window and redisplay normally--don't erase and redraw the frame.

(defun recenter (&optional arg)
  (interactive "P"))

Scroll text of selected window down ARG lines. If ARG is omitted or nil, scroll down by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. If ARG is the atom `-', scroll upward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'.

(defun scroll-down (&optional arg)
  (interactive "^P"))

Return t if OBJECT is a window-configuration object.

(defun window-configuration-p (object))

Return the minibuffer window for frame FRAME. If FRAME is omitted or nil, it defaults to the selected frame.

(defun minibuffer-window (&optional frame)
  (let [^Frame frame (or frame (frame/selected-frame))]
    (.minibuffer-window frame)))

Scroll text of selected window upward ARG lines. If ARG is omitted or nil, scroll upward by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. If ARG is the atom `-', scroll downward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'.

(defun scroll-up (&optional arg)
  (interactive "^P"))

Return the other window for "other window scroll" commands. If `other-window-scroll-buffer' is non-nil, a window showing that buffer is used. If in the minibuffer, `minibuffer-scroll-window' if non-nil specifies the window. This takes precedence over `other-window-scroll-buffer'.

(defun other-window-for-scrolling ())

Set WINDOW's display-table to TABLE.

(defun set-window-display-table (window table))

Return the parent window of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Return nil for a window with no parent (e.g. a root window).

(defun window-parent (&optional window)
  @(.parent ^Window (el/check-type 'windowp (or window (selected-window)))))

Return non-nil if position POS is currently on the frame in WINDOW. Return nil if that position is scrolled vertically out of view. If a character is only partially visible, nil is returned, unless the optional argument PARTIALLY is non-nil. If POS is only out of view because of horizontal scrolling, return non-nil. If POS is t, it specifies the position of the last visible glyph in WINDOW. POS defaults to point in WINDOW; WINDOW defaults to the selected window.

If POS is visible, return t if PARTIALLY is nil; if PARTIALLY is non-nil, return value is a list of 2 or 6 elements (X Y [RTOP RBOT ROWH VPOS]), where X and Y are the pixel coordinates relative to the top left corner of the window. The remaining elements are omitted if the character after POS is fully visible; otherwise, RTOP and RBOT are the number of pixels off-window at the top and bottom of the row, ROWH is the height of the display row, and VPOS is the row number (0-based) containing POS.

(defun pos-visible-in-window-p (&optional pos window partially))

Resize minibuffer window WINDOW.

(defun resize-mini-window-internal (window))

Return position at which display currently ends in WINDOW. WINDOW must be a live window and defaults to the selected one. This is updated by redisplay, when it runs to completion. Simply changing the buffer text or setting `window-start' does not update this value. Return nil if there is no recorded value. (This can happen if the last redisplay of WINDOW was preempted, and did not finish.) If UPDATE is non-nil, compute the up-to-date position if it isn't already recorded.

(defun window-end (&optional window update))

Set width of marginal areas of window WINDOW. If WINDOW is nil, set margins of the currently selected window. Second arg LEFT-WIDTH specifies the number of character cells to reserve for the left marginal area. Optional third arg RIGHT-WIDTH does the same for the right marginal area. A nil width parameter means no margin.

(defun set-window-margins (window left-width &optional right-width))

Make point value in WINDOW be at position POS in WINDOW's buffer. Return POS.

(defun set-window-point (window pos)
  ;; There's an attempt to track this in set-window-buffer and select-window
  (el/check-type 'integerp pos)
  (let [window ^Window (el/check-type 'windowp (or window (selected-window)))]
    (reset! (.pointm window)  ((ns-resolve 'deuce.emacs.buffer 'allocate-marker) nil (window-buffer window) pos))
    (reset! (.pt ^Buffer (window-buffer window)) pos)))

Return current value of point in WINDOW. WINDOW must be a live window and defaults to the selected one.

For a nonselected window, this is the value point would have if that window were selected.

Note that, when WINDOW is the selected window and its buffer is also currently selected, the value returned is the same as (point). It would be more strictly correct to return the `top-level' value of point, outside of any save-excursion forms. But that is hard to define.

(defun window-point (&optional window)
  ;; There's an attempt to track this in set-window-buffer and select-window
  (let [window (el/check-type 'windowp (or window (selected-window)))]
    (if-let [pointm (and (not= (selected-window) window) @(.pointm ^Window window))]
      (.charpos ^Marker pointm)
      @(.pt ^Buffer (window-buffer window)))))

Return a list of the edge pixel coordinates of WINDOW. The list has the form (LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at the top left corner of the frame.

RIGHT is one more than the rightmost x position occupied by WINDOW. BOTTOM is one more than the bottommost y position occupied by WINDOW. The pixel edges include the space used by WINDOW's scroll bar, display margins, fringes, header line, and/or mode line. For the pixel edges of just the text area, use `window-inside-pixel-edges'.

(defun window-pixel-edges (&optional window))

Return left column of window WINDOW. This is the distance, in columns, between the left edge of WINDOW and the left edge of the frame's window area. For instance, the return value is 0 if there is no window to the left of WINDOW.

If WINDOW is omitted or nil, it defaults to the selected window.

(defun window-left-column (&optional window)
  @(.left-col ^Window (el/check-type 'windowp (or window (selected-window)))))

Return the next sibling window of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Return nil if WINDOW has no next sibling.

(defun window-next-sibling (&optional window)
  @(.next ^Window (el/check-type 'windowp (or window (selected-window)))))

Return list of buffers recently re-shown in WINDOW. WINDOW must be a live window and defaults to the selected one.

(defun window-next-buffers (&optional window)
  (cons/maybe-seq (@window-next-buffers-list (el/check-type 'windowp (or window (selected-window))))))

Set combination limit of window WINDOW to LIMIT; return LIMIT. If LIMIT is nil, child windows of WINDOW can be recombined with WINDOW's siblings. LIMIT t means that child windows of WINDOW are never (re-)combined with WINDOW's siblings. Other values are reserved for future use.

(defun set-window-combination-limit (window limit))

Set WINDOW's next buffers to NEXT-BUFFERS. WINDOW must be a live window and defaults to the selected one. NEXT-BUFFERS should be a list of buffers.

(defun set-window-next-buffers (window next-buffers)
  (swap! window-next-buffers-list assoc (el/check-type 'windowp window) next-buffers)
  nil)

This function is obsolete since 23.1.

Set WINDOW's redisplay end trigger value to VALUE. VALUE should be a buffer position (typically a marker) or nil. If it is a buffer position, then if redisplay in WINDOW reaches a position beyond VALUE, the functions in `redisplay-end-trigger-functions' are called with two arguments: WINDOW, and the end trigger value. Afterwards the end-trigger value is reset to nil.

(defun set-window-redisplay-end-trigger (window value))

Return an object representing the current window configuration of FRAME. If FRAME is nil or omitted, use the selected frame. This describes the number of windows, their sizes and current buffers, and for each displayed buffer, where display starts, and the positions of point and mark. An exception is made for point in the current buffer: its value is -not- saved. This also records the currently selected frame, and FRAME's focus redirection (see `redirect-frame-focus'). The variable `window-persistent-parameters' specifies which window parameters are saved by this function.

(defun current-window-configuration (&optional frame))

Set WINDOW's value of PARAMETER to VALUE. WINDOW defaults to the selected window. Return VALUE.

(defun set-window-parameter (window parameter value))

Return non-nil if COORDINATES are in WINDOW. WINDOW must be a live window. COORDINATES is a cons of the form (X . Y), X and Y being distances measured in characters from the upper-left corner of the frame. (0 . 0) denotes the character in the upper left corner of the frame. If COORDINATES are in the text portion of WINDOW, the coordinates relative to the window are returned. If they are in the mode line of WINDOW, `mode-line' is returned. If they are in the top mode line of WINDOW, `header-line' is returned. If they are in the left fringe of WINDOW, `left-fringe' is returned. If they are in the right fringe of WINDOW, `right-fringe' is returned. If they are on the border between WINDOW and its right sibling, `vertical-line' is returned. If they are in the windows's left or right marginal areas, `left-margin' or `right-margin' is returned.

(defun coordinates-in-window-p (coordinates window))

Return top line of window WINDOW. This is the distance, in lines, between the top of WINDOW and the top of the frame's window area. For instance, the return value is 0 if there is no window above WINDOW.

If WINDOW is omitted or nil, it defaults to the selected window.

(defun window-top-line (&optional window)
  @(.top-line ^Window (el/check-type 'windowp (or window (selected-window)))))

Return height in pixels of text line LINE in window WINDOW. WINDOW defaults to the selected window.

Return height of current line if LINE is omitted or nil. Return height of header or mode line if LINE is header-line' ormode-line'. Otherwise, LINE is a text line number starting from 0. A negative number counts from the end of the window.

Value is a list (HEIGHT VPOS YPOS OFFBOT), where HEIGHT is the height in pixels of the visible part of the line, VPOS and YPOS are the vertical position in lines and pixels of the line, relative to the top of the first text line, and OFFBOT is the number of off-window pixels at the bottom of the text line. If there are off-window pixels at the top of the (first) text line, YPOS is negative.

Return nil if window display is not up-to-date. In that case, use `pos-visible-in-window-p' to obtain the information.

(defun window-line-height (&optional line window))

Set width and type of scroll bars of window WINDOW. If window is nil, set scroll bars of the currently selected window. Second parameter WIDTH specifies the pixel width for the scroll bar; this is automatically adjusted to a multiple of the frame column width. Third parameter VERTICAL-TYPE specifies the type of the vertical scroll bar: left, right, or nil. If WIDTH is nil, use the frame's scroll-bar width. If VERTICAL-TYPE is t, use the frame's scroll-bar type. Fourth parameter HORIZONTAL-TYPE is currently unused.

(defun set-window-scroll-bars (window width &optional vertical-type horizontal-type))

Run `window-configuration-change-hook' for FRAME.

(defun run-window-configuration-change-hook (frame))

Get width of marginal areas of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Value is a cons of the form (LEFT-WIDTH . RIGHT-WIDTH). If a marginal area does not exist, its width will be returned as nil.

(defun window-margins (&optional window))

Make WINDOW fill its frame. Only the frame WINDOW is on is affected. WINDOW may be any window and defaults to the selected one.

Optional argument ROOT, if non-nil, must specify an internal window such that WINDOW is in its window subtree. If this is the case, replace ROOT by WINDOW and leave alone any windows not part of ROOT's subtree.

When WINDOW is live try to reduce display jumps by keeping the text previously visible in WINDOW in the same place on the frame. Doing this depends on the value of (window-start WINDOW), so if calling this function in a program gives strange scrolling, make sure the window-start value is reasonable when this function is called.

(defun delete-other-windows-internal (&optional window root)
  (interactive))

Return a list of the edge pixel coordinates of WINDOW's text area. The list has the form (LEFT TOP RIGHT BOTTOM), all relative to (0,0) at the top left corner of the frame's window area.

RIGHT is one more than the rightmost x position of WINDOW's text area. BOTTOM is one more than the bottommost y position of WINDOW's text area. The inside edges do not include the space used by WINDOW's scroll bar, display margins, fringes, header line, and/or mode line.

(defun window-inside-pixel-edges (&optional window))

Return the use time of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. The window with the highest use time is the most recently selected one. The window with the lowest use time is the least recently selected one.

(defun window-use-time (&optional window))

Split window OLD. Second argument TOTAL-SIZE specifies the number of lines or columns of the new window. In any case TOTAL-SIZE must be a positive integer.

Third argument SIDE nil (or `below') specifies that the new window shall be located below WINDOW. SIDE `above' means the new window shall be located above WINDOW. In both cases TOTAL-SIZE specifies the number of lines of the new window including space reserved for the mode and/or header line.

SIDE t (or `right') specifies that the new window shall be located on the right side of WINDOW. SIDE `left' means the new window shall be located on the left of WINDOW. In both cases TOTAL-SIZE specifies the number of columns of the new window including space reserved for fringes and the scrollbar or a divider column.

Fourth argument NORMAL-SIZE specifies the normal size of the new window according to the SIDE argument.

The new total and normal sizes of all involved windows must have been set correctly. See the code of `split-window' for how this is done.

(defun split-window-internal (old total-size side normal-size))

Return the frame that CONFIG, a window-configuration object, is about.

(defun window-configuration-frame (config))

Set new total size of WINDOW to SIZE. Return SIZE.

Optional argument ADD non-nil means add SIZE to the new total size of WINDOW and return the sum.

Note: This function does not operate on any child windows of WINDOW.

(defun set-window-new-total (window size &optional add))

Return position at which display currently starts in WINDOW. WINDOW must be a live window and defaults to the selected one. This is updated by redisplay or by calling `set-window-start'.

(defun window-start (&optional window))

Make WINDOW display BUFFER-OR-NAME as its contents. WINDOW has to be a live window and defaults to the selected one. BUFFER-OR-NAME must be a buffer or the name of an existing buffer.

Optional third argument KEEP-MARGINS non-nil means that WINDOW's current display margins, fringe widths, and scroll bar settings are preserved; the default is to reset these from the local settings for BUFFER-OR-NAME or the frame defaults. Return nil.

This function throws an error when WINDOW is strongly dedicated to its buffer (that is `window-dedicated-p' returns t for WINDOW) and does not already display BUFFER-OR-NAME.

This function runs `window-scroll-functions' before running `window-configuration-change-hook'.

(defun set-window-buffer (window buffer-or-name &optional keep-margins)
  (reset! (.buffer ^Window (el/check-type 'windowp (or window (selected-window))))
          (el/check-type 'bufferp (buffer/get-buffer buffer-or-name)))
  nil)

Return WINDOW's value for PARAMETER. WINDOW defaults to the selected window.

(defun window-parameter (window parameter))

This function is obsolete since 23.1.

Return WINDOW's redisplay end trigger value. WINDOW defaults to the selected window. See `set-window-redisplay-end-trigger' for more information.

(defun window-redisplay-end-trigger (&optional window))

Select WINDOW. Most editing will apply to WINDOW's buffer. Also make WINDOW's buffer current and make WINDOW the frame's selected window. Return WINDOW.

Optional second arg NORECORD non-nil means do not put this buffer at the front of the buffer list and do not make this window the most recently selected one.

Note that the main editor command loop sets the current buffer to the buffer of the selected window before each command.

(defun select-window (window &optional norecord)
  (el/check-type 'windowp window)
  (when (selected-window)
    (set-window-point (selected-window) (window-point (selected-window))))
  (buffer/set-buffer (window-buffer window))
  (when-not @(.pointm ^Window window)
    (set-window-point window @(.pt ^Buffer (window-buffer window))))
  (reset! (.selected-window ^Frame (frame/selected-frame)) window))

Return a list of the edge pixel coordinates of WINDOW. The list has the form (LEFT TOP RIGHT BOTTOM), all relative to 0, 0 at the top left corner of the display.

RIGHT is one more than the rightmost x position occupied by WINDOW. BOTTOM is one more than the bottommost y position occupied by WINDOW. The pixel edges include the space used by WINDOW's scroll bar, display margins, fringes, header line, and/or mode line. For the pixel edges of just the text area, use `window-inside-absolute-pixel-edges'.

(defun window-absolute-pixel-edges (&optional window))

Return the total height, in lines, of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window.

The return value includes the mode line and header line, if any. If WINDOW is an internal window, the total height is the height of the screen areas spanned by its children.

On a graphical display, this total height is reported as an integer multiple of the default character height.

(defun window-total-height (&optional window)
  (let [window ^Window (el/check-type 'windowp (or window (selected-window)))
        minibuffer? (window-minibuffer-p window)
        buffer (window-buffer window)
        [header-line mode-line] (when-not minibuffer?
                                  [(buffer/buffer-local-value 'header-line-format buffer)
                                   (buffer/buffer-local-value 'mode-line-format buffer)])]
    (+ (if mode-line 1 0)
       (if header-line 1 0)
       @(.total-lines window))))

Return live window after WINDOW in the cyclic ordering of windows. WINDOW must be a live window and defaults to the selected one. The optional arguments MINIBUF and ALL-FRAMES specify the set of windows to consider.

MINIBUF nil or omitted means consider the minibuffer window only if the minibuffer is active. MINIBUF t means consider the minibuffer window even if the minibuffer is not active. Any other value means do not consider the minibuffer window even if the minibuffer is active.

ALL-FRAMES nil or omitted means consider all windows on WINDOW's frame, plus the minibuffer window if specified by the MINIBUF argument. If the minibuffer counts, consider all windows on all frames that share that minibuffer too. The following non-nil values of ALL-FRAMES have special meanings:

  • t means consider all windows on all existing frames.

  • `visible' means consider all windows on all visible frames.

  • 0 (the number zero) means consider all windows on all visible and iconified frames.

  • A frame means consider all windows on that frame only.

    Anything else means consider all windows on WINDOW's frame and no others.

    If you use consistent values for MINIBUF and ALL-FRAMES, you can use `next-window' to iterate through the entire cycle of acceptable windows, eventually ending up back at the window you started with. `previous-window' traverses the same cycle, in the reverse order.

(defun next-window (&optional window minibuf all-frames))

Return non-nil if WINDOW is a minibuffer window. If WINDOW is omitted or nil, it defaults to the selected window.

(defun window-minibuffer-p (&optional window)
  (.mini-p ^Window (el/check-type 'windowp (or window (selected-window)))))

Return the topmost, leftmost live window on FRAME-OR-WINDOW. If omitted, FRAME-OR-WINDOW defaults to the currently selected frame. Else if FRAME-OR-WINDOW denotes any window, return the first window of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return the first window of that frame.

(defun frame-first-window (&optional frame-or-window))

Get width and type of scroll bars of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Value is a list of the form (WIDTH COLS VERTICAL-TYPE HORIZONTAL-TYPE). If WIDTH is nil or TYPE is t, the window is using the frame's corresponding value.

(defun window-scroll-bars (&optional window))

Return non-nil when WINDOW is dedicated to its buffer. More precisely, return the value assigned by the last call of `set-window-dedicated-p' for WINDOW. Return nil if that function was never called with WINDOW as its argument, or the value set by that function was internally reset since its last call. WINDOW defaults to the selected window.

When a window is dedicated to its buffer, `display-buffer' will refrain from displaying another buffer in it. `get-lru-window' and `get-largest-window' treat dedicated windows specially. delete-windows-on',replace-buffer-in-windows', `quit-window' and `kill-buffer' can delete a dedicated window and the containing frame.

Functions like `set-window-buffer' may change the buffer displayed by a window, unless that window is "strongly" dedicated to its buffer, that is the value returned by `window-dedicated-p' is t.

(defun window-dedicated-p (&optional window))

Return the selected window. The selected window is the window in which the standard cursor for selected windows appears and to which many commands apply.

(defun selected-window ()
  @(.selected-window  ^Frame (frame/selected-frame)))

Position point relative to window. ARG nil means position point at center of window. Else, ARG specifies vertical position within the window; zero means top of window, negative means relative to bottom of window.

(defun move-to-window-line (arg)
  (interactive "P"))

Set amount by which WINDOW should be scrolled vertically to VSCROLL. WINDOW nil means use the selected window. Normally, VSCROLL is a non-negative multiple of the canonical character height of WINDOW; optional third arg PIXELS-P non-nil means that VSCROLL is in pixels. If PIXELS-P is nil, VSCROLL may have to be rounded so that it corresponds to an integral number of pixels. The return value is the result of this rounding. If PIXELS-P is non-nil, the return value is VSCROLL.

(defun set-window-vscroll (window vscroll &optional pixels-p)
  vscroll)

Return new normal size of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window.

(defun window-new-normal (&optional window))

Return the amount by which WINDOW is scrolled vertically. If WINDOW is omitted or nil, it defaults to the selected window. Normally, value is a multiple of the canonical character height of WINDOW; optional second arg PIXELS-P means value is measured in pixels.

(defun window-vscroll (&optional window pixels-p)
  0)

Return a window currently displaying BUFFER-OR-NAME, or nil if none. BUFFER-OR-NAME may be a buffer or a buffer name and defaults to the current buffer.

The optional argument ALL-FRAMES specifies the frames to consider:

  • t means consider all windows on all existing frames.

  • `visible' means consider all windows on all visible frames.

  • 0 (the number zero) means consider all windows on all visible and iconified frames.

  • A frame means consider all windows on that frame only.

    Any other value of ALL-FRAMES means consider all windows on the selected frame and no others.

(defun get-buffer-window (&optional buffer-or-name all-frames))

Return the display-table that WINDOW is using. WINDOW defaults to the selected window.

(defun window-display-table (&optional window))

Return a list of windows on FRAME, starting with WINDOW. FRAME nil or omitted means use the selected frame. WINDOW nil or omitted means use the window selected within FRAME. MINIBUF t means include the minibuffer window, even if it isn't active. MINIBUF nil or omitted means include the minibuffer window only if it's active. MINIBUF neither nil nor t means never include the minibuffer window.

(defun window-list (&optional frame minibuf window)
  (let [^Frame frame (or frame (frame/selected-frame))]
    (loop [w ^Window (el/check-type 'windowp (or window (.root-window frame)))
           acc []]
      (if w
        (recur @(.next w)
               (concat
                (when-let [h @(.hchild w)] (window-list frame minibuf h))
                (when-let [v @(.vchild w)] (window-list frame minibuf v))
                (if (and (not minibuf) (.mini-p w))
                  acc
                  (conj acc w))))
        (cons/maybe-seq (reverse acc))))))

Return the root window of FRAME-OR-WINDOW. If omitted, FRAME-OR-WINDOW defaults to the currently selected frame. With a frame argument, return that frame's root window. With a window argument, return the root window of that window's frame.

(defun frame-root-window (&optional frame-or-window)
  (let [frame (if (frame/framep frame-root-window)
                frame-root-window
                (window-frame frame-or-window))
        ^Frame frame (or frame (frame/selected-frame))]
    (.root-window frame)))

Get width of fringes of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Value is a list of the form (LEFT-WIDTH RIGHT-WIDTH OUTSIDE-MARGINS).

(defun window-fringes (&optional window))

Return the parameters of WINDOW and their values. WINDOW defaults to the selected window. The return value is a list of elements of the form (PARAMETER . VALUE).

(defun window-parameters (&optional window))

Return window containing coordinates X and Y on FRAME. FRAME must be a live frame and defaults to the selected one. The top left corner of the frame is considered to be row 0, column 0.

(defun window-at (x y &optional frame))

Return the buffer displayed in window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Return nil for an internal window or a deleted window.

(defun window-buffer (&optional window)
  @(.buffer ^Window (el/check-type 'windowp (or window (selected-window)))))

Set the configuration of windows and buffers as specified by CONFIGURATION. CONFIGURATION must be a value previously returned by `current-window-configuration' (which see). If CONFIGURATION was made from a frame that is now deleted, only frame-independent values can be restored. In this case, the return value is nil. Otherwise the value is t.

(defun set-window-configuration (configuration))

Force all windows to be updated on next redisplay. If optional arg OBJECT is a window, force redisplay of that window only. If OBJECT is a buffer or buffer name, force redisplay of all windows displaying that buffer.

(defun force-window-update (&optional object))

Return a list of all live windows. WINDOW specifies the first window to list and defaults to the selected window.

Optional argument MINIBUF nil or omitted means consider the minibuffer window only if the minibuffer is active. MINIBUF t means consider the minibuffer window even if the minibuffer is not active. Any other value means do not consider the minibuffer window even if the minibuffer is active.

Optional argument ALL-FRAMES nil or omitted means consider all windows on WINDOW's frame, plus the minibuffer window if specified by the MINIBUF argument. If the minibuffer counts, consider all windows on all frames that share that minibuffer too. The following non-nil values of ALL-FRAMES have special meanings:

  • t means consider all windows on all existing frames.

  • `visible' means consider all windows on all visible frames.

  • 0 (the number zero) means consider all windows on all visible and iconified frames.

  • A frame means consider all windows on that frame only.

    Anything else means consider all windows on WINDOW's frame and no others.

    If WINDOW is not on the list of windows returned, some other window will be listed first but no error is signaled.

(defun window-list-1 (&optional window minibuf all-frames)
  (cons/maybe-seq (cons (selected-window) (remove #{(selected-window)} (filter window-live-p (window-list nil minibuf))))))

Set the fringe widths of window WINDOW. If WINDOW is nil, set the fringe widths of the currently selected window. Second arg LEFT-WIDTH specifies the number of pixels to reserve for the left fringe. Optional third arg RIGHT-WIDTH specifies the right fringe width. If a fringe width arg is nil, that means to use the frame's default fringe width. Default fringe widths can be set with the command `set-fringe-style'. If optional fourth arg OUTSIDE-MARGINS is non-nil, draw the fringes outside of the display margins. By default, fringes are drawn between display marginal areas and the text area.

(defun set-window-fringes (window left-width &optional right-width outside-margins))

Remove WINDOW from its frame. WINDOW defaults to the selected window. Return nil. Signal an error when WINDOW is the only window on its frame.

(defun delete-window-internal (window))

Return the number of columns by which WINDOW is scrolled from left margin. WINDOW must be a live window and defaults to the selected one.

(defun window-hscroll (&optional window)
  0)

Return the previous sibling window of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. Return nil if WINDOW has no previous sibling.

(defun window-prev-sibling (&optional window)
  @(.prev ^Window (el/check-type 'windowp (or window (selected-window)))))

Return the width, in columns, of WINDOW's text area. If WINDOW is omitted or nil, it defaults to the selected window. Signal an error if the window is not live.

The return value does not include any vertical dividers, fringe or marginal areas, or scroll bars. On a graphical display, the width is expressed as an integer multiple of the default character width.

(defun window-body-width (&optional window)
  @(.total-cols ^Window (el/check-type 'windowp (or window (selected-window)))))

Set WINDOW's previous buffers to PREV-BUFFERS. WINDOW must be a live window and defaults to the selected one.

PREV-BUFFERS should be a list of elements (BUFFER WINDOW-START POS), where BUFFER is a buffer, WINDOW-START is the start position of the window for that buffer, and POS is a window-specific point value.

(defun set-window-prev-buffers (window prev-buffers)
  (swap! window-prev-buffers-list assoc (el/check-type 'windowp window) prev-buffers)
  nil)

Return buffers previously shown in WINDOW. WINDOW must be a live window and defaults to the selected one.

The return value is a list of elements (BUFFER WINDOW-START POS), where BUFFER is a buffer, WINDOW-START is the start position of the window for that buffer, and POS is a window-specific point value.

(defun window-prev-buffers (&optional window)
  (cons/maybe-seq (@window-prev-buffers-list (el/check-type 'windowp (or window (selected-window))))))

Return the window which was selected when entering the minibuffer. Returns nil, if selected window is not a minibuffer window.

(defun minibuffer-selected-window ())

Return t if OBJECT is a window and nil otherwise.

(defun windowp (object)
  (instance? Window object))

Mark WINDOW as dedicated according to FLAG. WINDOW must be a live window and defaults to the selected one. FLAG non-nil means mark WINDOW as dedicated to its buffer. FLAG nil means mark WINDOW as non-dedicated. Return FLAG.

When a window is dedicated to its buffer, `display-buffer' will refrain from displaying another buffer in it. `get-lru-window' and `get-largest-window' treat dedicated windows specially. delete-windows-on',replace-buffer-in-windows', `quit-window', quit-restore-window' andkill-buffer' can delete a dedicated window and the containing frame.

As a special case, if FLAG is t, mark WINDOW as "strongly" dedicated to its buffer. Functions like `set-window-buffer' may change the buffer displayed by a window, unless that window is strongly dedicated to its buffer. If and when `set-window-buffer' displays another buffer in a window, it also makes sure that the window is no more dedicated.

(defun set-window-dedicated-p (window flag))

Return the height in lines of the text display area of WINDOW. If WINDOW is omitted or nil, it defaults to the selected window.

The returned height does not include the mode line, any header line, nor any partial-height lines at the bottom of the text area.

(defun window-text-height (&optional window))

Set selected window of FRAME to WINDOW. FRAME must be a live frame and defaults to the selected one. If FRAME is the selected frame, this makes WINDOW the selected window. Optional argument NORECORD non-nil means to neither change the order of recently selected windows nor the buffer list. WINDOW must denote a live window. Return WINDOW.

(defun set-frame-selected-window (frame window &optional norecord))

Return a list of the edge coordinates of WINDOW. The list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM count by lines, and LEFT and RIGHT count by columns, all relative to 0, 0 at top left corner of frame.

RIGHT is one more than the rightmost column of WINDOW's text area. BOTTOM is one more than the bottommost row of WINDOW's text area. The inside edges do not include the space used by the WINDOW's scroll bar, display margins, fringes, header line, and/or mode line.

(defun window-inside-edges (&optional window))

Return the selected window of FRAME-OR-WINDOW. If omitted, FRAME-OR-WINDOW defaults to the currently selected frame. Else if FRAME-OR-WINDOW denotes any window, return the selected window of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return the selected window of that frame.

(defun frame-selected-window (&optional frame-or-window))

Return the height, in lines, of WINDOW's text area. If WINDOW is omitted or nil, it defaults to the selected window. Signal an error if the window is not live.

The returned height does not include the mode line or header line. On a graphical display, the height is expressed as an integer multiple of the default character height. If a line at the bottom of the text area is only partially visible, that counts as a whole line; to exclude partially-visible lines, use `window-text-height'.

(defun window-body-height (&optional window)
  @(.total-lines ^Window (el/check-type 'windowp (or window (selected-window)))))

Return live window before WINDOW in the cyclic ordering of windows. WINDOW must be a live window and defaults to the selected one. The optional arguments MINIBUF and ALL-FRAMES specify the set of windows to consider.

MINIBUF nil or omitted means consider the minibuffer window only if the minibuffer is active. MINIBUF t means consider the minibuffer window even if the minibuffer is not active. Any other value means do not consider the minibuffer window even if the minibuffer is active.

ALL-FRAMES nil or omitted means consider all windows on WINDOW's frame, plus the minibuffer window if specified by the MINIBUF argument. If the minibuffer counts, consider all windows on all frames that share that minibuffer too. The following non-nil values of ALL-FRAMES have special meanings:

  • t means consider all windows on all existing frames.

  • `visible' means consider all windows on all visible frames.

  • 0 (the number zero) means consider all windows on all visible and iconified frames.

  • A frame means consider all windows on that frame only.

    Anything else means consider all windows on WINDOW's frame and no others.

    If you use consistent values for MINIBUF and ALL-FRAMES, you can use `previous-window' to iterate through the entire cycle of acceptable windows, eventually ending up back at the window you started with. `next-window' traverses the same cycle, in the reverse order.

(defun previous-window (&optional window minibuf all-frames))

Set new normal size of WINDOW to SIZE. Return SIZE.

Note: This function does not operate on any child windows of WINDOW.

(defun set-window-new-normal (window &optional size))

Scroll selected window display ARG columns right. Default for ARG is window width minus 2. Value is the total amount of leftward horizontal scrolling in effect after the change. If SET-MINIMUM is non-nil, the new scroll amount becomes the lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned by this function. This happens in an interactive call.

(defun scroll-right (&optional arg set-minimum)
  (interactive "^P\np"))

Make display in WINDOW start at position POS in WINDOW's buffer. If WINDOW is nil, the selected window is used. Return POS. Optional third arg NOFORCE non-nil inhibits next redisplay from overriding motion of point in order to display at this exact start.

(defun set-window-start (window pos &optional noforce))

Return the topmost child window of window WINDOW. Return nil if WINDOW is a live window (live windows have no children). Return nil if WINDOW is an internal window whose children form a horizontal combination.

(defun window-top-child (window)
  @(.vchild ^Window (el/check-type 'windowp window)))

Return the new total size of window WINDOW. If WINDOW is omitted or nil, it defaults to the selected window.

(defun window-new-total (&optional window))

Return the frame that window WINDOW is on. If WINDOW is omitted or nil, it defaults to the selected window.

(defun window-frame (window)
  (frame/selected-frame))

Scroll selected window display ARG columns left. Default for ARG is window width minus 2. Value is the total amount of leftward horizontal scrolling in effect after the change. If SET-MINIMUM is non-nil, the new scroll amount becomes the lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned by this function. This happens in an interactive call.

(defun scroll-left (&optional arg set-minimum)
  (interactive "^P\np"))

Return the leftmost child window of window WINDOW. Return nil if WINDOW is a live window (live windows have no children). Return nil if WINDOW is an internal window whose children form a vertical combination.

(defun window-left-child (window)
  @(.hchild ^Window (el/check-type 'windowp window)))

Return a list of the edge coordinates of WINDOW. The list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM count by lines, and LEFT and RIGHT count by columns, all relative to 0, 0 at top left corner of frame.

RIGHT is one more than the rightmost column occupied by WINDOW. BOTTOM is one more than the bottommost row occupied by WINDOW. The edges include the space used by WINDOW's scroll bar, display margins, fringes, header line, and/or mode line. For the edges of just the text area, use `window-inside-edges'.

(defun window-edges (&optional window))

Apply requested size values for window-tree of FRAME. Optional argument HORIZONTAL omitted or nil means apply requested height values. HORIZONTAL non-nil means apply requested width values.

This function checks whether the requested values sum up to a valid window layout, recursively assigns the new sizes of all child windows and calculates and assigns the new start positions of these windows.

Note: This function does not check any of `window-fixed-size-p', window-min-height' orwindow-min-width'. All these checks have to be applied on the Elisp level.

(defun window-resize-apply (frame &optional horizontal))

Compare two window configurations as regards the structure of windows. This function ignores details such as the values of point and mark and scrolling positions.

(defun compare-window-configurations (x y))

Internal function for `with-output-to-temp-buffer'.

(defun internal-temp-output-buffer-show (buf))
 
(ns deuce.emacs.fns
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.data :refer [car cdr setcar setcdr] :as data]
            [deuce.emacs.lread :as lread]
            [deuce.emacs-lisp.cons :as cons]
            [deuce.emacs-lisp.globals :as globals])
  (import [clojure.lang IPersistentCollection PersistentVector]
          [deuce.emacs.data CharTable]
          [java.lang.management ManagementFactory]
          [java.util List Map HashMap Collections Objects Arrays Random]
          [java.nio CharBuffer]
          [java.nio.charset Charset]
          [javax.xml.bind DatatypeConverter]
          [java.security MessageDigest])
  (:refer-clojure :exclude [concat assoc reverse nth identity require get sort]))

*Non-nil means mouse commands use dialog boxes to ask questions. This applies to y-or-n-p' andyes-or-no-p' questions asked by commands invoked by mouse clicks and mouse menu items.

On some platforms, file selection dialogs are also enabled if this is non-nil.

You can customize this variable.

(defvar use-dialog-box nil)

*Non-nil means mouse commands use a file dialog to ask for files. This applies to commands from menus and tool bar buttons even when they are initiated from the keyboard. If `use-dialog-box' is nil, that disables the use of a file dialog, regardless of the value of this variable.

You can customize this variable.

(defvar use-file-dialog nil)

A list of symbols which are the features of the executing Emacs. Used by featurep' andrequire', and altered by `provide'.

(defvar features nil)

Announce that FEATURE is a feature of the current Emacs. The optional argument SUBFEATURES should be a list of symbols listing particular subfeatures supported in this version of FEATURE.

(defun provide (feature &optional subfeatures)
  (when-not (some #{feature} globals/features)
    (el/setq features (alloc/cons feature globals/features)))
  feature)

In WIDGET, get the value of PROPERTY. The value could either be specified when the widget was created, or later with `widget-put'.

(defun widget-get (widget property))

Return a multibyte string with the same individual bytes as STRING. If STRING is multibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties.

If STRING is unibyte and contains an individual 8-bit byte (i.e. not part of a correct utf-8 sequence), it is converted to the corresponding multibyte character of charset `eight-bit'. See also `string-to-multibyte'.

Beware, this often doesn't really do what you think it does. It is similar to (decode-coding-string STRING 'utf-8-emacs). If you're not sure, whether to use `string-as-multibyte' or string-to-multibyte', usestring-to-multibyte'.

(defun string-as-multibyte (string)
  (let [utf-8 (.newEncoder (Charset/forName "UTF-8"))]
    (String. (.array (.encode utf-8 (CharBuffer/wrap (str string)))) (.charset utf-8))))
(declare plist-put)

Change value in PLIST of PROP to VAL, comparing with `equal'. PLIST is a property list, which is a list of the form (PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects. If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects.

(defun lax-plist-put (plist prop val)
  (plist-put prop val))
(declare length)

Return the length of a list, but avoid error or infinite loop. This function never gets an error. If LIST is not really a list, it returns 0. If LIST is circular, it returns a finite value which is at least the number of distinct elements.

(defun safe-length (list)
  (if (data/sequencep list)
    (length list)
    0))
(declare equal mem)

Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT.

(defun member (elt list)
  (mem equal elt list))

Return a copy of hash table TABLE.

(defun copy-hash-table (table)
  (HashMap. ^Map table))

Concatenate all the arguments and make the result a list. The result is a list whose elements are the elements of all the arguments. Each argument xmay be a list, vector or string. The last argument is not copied, just used as the tail of the new list.

(defun append (&rest sequences)
  (if (every? data/null (rest sequences))
    (if (and (next sequences) (data/arrayp (first sequences)))
      (apply alloc/list (first sequences))
      (first sequences))
    (let [last (cons/maybe-seq (last sequences))]
      (if-let [l (apply alloc/list (apply c/concat (butlast sequences)))]
        (do
          (setcdr (cons/last-cons l) last)
          l)
        last))))

Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. In between each pair of results, stick in SEPARATOR. Thus, " " as SEPARATOR results in spaces between the values returned by FUNCTION. SEQUENCE may be a list, a vector, a bool-vector, or a string.

(defun mapconcat (function sequence separator)
  (s/join separator (map (el/fun function) (cons/maybe-seq sequence))))

Compare the contents of two strings, converting to multibyte if needed. In string STR1, skip the first START1 characters and stop at END1. In string STR2, skip the first START2 characters and stop at END2. END1 and END2 default to the full lengths of the respective strings.

Case is significant in this comparison if IGNORE-CASE is nil. Unibyte strings are converted to multibyte for comparison.

The value is t if the strings (or specified portions) match. If string STR1 is less, the value is a negative number N; - 1 - N is the number of characters that match at the beginning. If string STR1 is greater, the value is a positive number N; N - 1 is the number of characters that match at the beginning.

(defun compare-strings (str1 start1 end1 str2 start2 end2 &optional ignore-case)
  (let [[str1 str2] (if ignore-case
                      [(s/lower-case str1) (s/lower-case str2)]
                      [str1 str2])]
    (compare (subs str1 start1 (or end1 (count str1)))
             (subs str2 start2 (or end2 (count str2))))))

Return a copy of ALIST. This is an alist which represents the same mapping from objects to objects, but does not share the alist structure with ALIST. The objects mapped (cars and cdrs of elements of the alist) are shared, however. Elements of ALIST that are not conses are also shared.

(defun copy-alist (alist)
  alist)

Return the secure hash of OBJECT, a buffer or string. ALGORITHM is a symbol specifying the hash to use: md5, sha1, sha224, sha256, sha384 or sha512.

The two optional arguments START and END are positions specifying for which part of OBJECT to compute the hash. If nil or omitted, uses the whole OBJECT.

If BINARY is non-nil, returns a string in binary form.

(defun secure-hash (algorithm object &optional start end binary)
  (let [hash (.digest (MessageDigest/getInstance (str algorithm))
                      (.getBytes (subs object (or start 0) (or end (count object))) "UTF-8"))]
    (if binary hash
        (apply str (map #(format "%02x" %) hash)))))

Return a copy of a list, vector, string or char-table. The elements of a list or vector are not copied; they are shared with the original.

(defun copy-sequence (arg)
  (condp some [arg]
    data/char-table-p (let [^CharTable arg arg]
                        (CharTable. (.defalt arg) (atom @(.parent arg)) (.purpose arg)
                                    (apply alloc/vector (.contents arg))
                                    (when (.extras arg)
                                      (apply alloc/vector (.extras arg)))))
    data/listp (apply alloc/list arg)
    data/vectorp (apply alloc/vector arg)
    data/stringp (apply alloc/string arg)))

Return a unibyte string with the same individual bytes as STRING. If STRING is unibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties. If STRING is multibyte and contains a character of charset `eight-bit', it is converted to the corresponding single byte.

(defun string-as-unibyte (string)
  (let [ascii (.newEncoder (Charset/forName "US-ASCII"))]
    (String. (.array (.encode ascii (CharBuffer/wrap (str string)))) (.charset ascii))))

Compute a hash code for OBJ and return it as integer.

(defun sxhash (obj)
  (hash obj))

Return MD5 message digest of OBJECT, a buffer or string.

A message digest is a cryptographic checksum of a document, and the algorithm to calculate it is defined in RFC 1321.

The two optional arguments START and END are character positions specifying for which part of OBJECT the message digest should be computed. If nil or omitted, the digest is computed for the whole OBJECT.

The MD5 message digest is computed from the result of encoding the text in a coding system, not directly from the internal Emacs form of the text. The optional fourth argument CODING-SYSTEM specifies which coding system to encode the text with. It should be the same coding system that you used or will use when actually writing the text into a file.

If CODING-SYSTEM is nil or omitted, the default depends on OBJECT. If OBJECT is a buffer, the default for CODING-SYSTEM is whatever coding system would be chosen by default for writing this text into a file.

If OBJECT is a string, the most preferred coding system (see the command `prefer-coding-system') is used.

If NOERROR is non-nil, silently assume the `raw-text' coding if the guesswork fails. Normally, an error is signaled in such case.

(defun md5 (object &optional start end coding-system noerror)
  (secure-hash 'md5 object start end))

Apply the value of WIDGET's PROPERTY to the widget itself. ARGS are passed as extra arguments to the function.

(defun widget-apply (widget property &rest args))

Return t if OBJ is a Lisp hash table object.

(defun hash-table-p (obj)
  (instance? Map obj))
(declare del)

Delete by side effect any occurrences of ELT as a member of SEQ. SEQ must be a list, a vector, or a string. The modified SEQ is returned. Comparison is done with `equal'. If SEQ is not a list, or the first member of SEQ is ELT, deleting it is not a side effect; it is simply using a different sequence. Therefore, write `(setq foo (delete element foo))' to be sure of changing the value of `foo'.

(defun delete (elt seq)
  (cond
   (data/consp seq) (del equal elt seq)
   (data/vectorp seq) (apply alloc/vector (del equal elt (apply alloc/list seq)))
   (and (data/stringp seq) (integer? elt)) (s/replace seq (c/str (c/char elt)) "")
   :else seq))

Access locale data ITEM for the current C locale, if available. ITEM should be one of the following:

`codeset', returning the character set as a string (locale item CODESET);

`days', returning a 7-element vector of day names (locale items DAY_n);

`months', returning a 12-element vector of month names (locale items MON_n);

`paper', returning a list (WIDTH HEIGHT) for the default paper size, both measured in millimeters (locale items PAPERWIDTH, PAPERHEIGHT).

If the system can't provide such information through a call to `nl_langinfo', or if ITEM isn't from the list above, return nil.

See also Info node `(libc)Locales'.

The data read from the system are decoded using `locale-coding-system'.

(defun locale-info (item))

Return a multibyte string with the same individual chars as STRING. If STRING is multibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties.

If STRING is unibyte and contains an 8-bit byte, it is converted to the corresponding multibyte character of charset `eight-bit'.

This differs from `string-as-multibyte' by converting each byte of a correct utf-8 sequence to an eight-bit character, not just bytes that don't form a correct sequence.

(defun string-to-multibyte (string)
  (string-as-multibyte string))

Return t if the two args are the same Lisp object. Floating-point numbers of equal value are eql', but they may not beeq'.

(defun eql (obj1 obj2)
  (cond
    (and (float? obj1) (float obj2)) (== obj1 obj2)
    :else (data/eq obj1 obj2)))
(defn ^:private plist-map [plist]
  (if (instance? Map plist) plist (into {} (map vec (partition 2 plist)))))

Extract a value from a property list. PLIST is a property list, which is a list of the form (PROP1 VALUE1 PROP2 VALUE2...). This function returns the value corresponding to the given PROP, or nil if PROP is not one of the properties on the list. This function never signals an error.

(defun plist-get (plist prop)
  ((plist-map plist) prop))

Return element of SEQUENCE at index N.

(defun elt (sequence n)
  (c/nth (cons/maybe-seq sequence) n))

Base64-encode STRING and return the result. Optional second argument NO-LINE-BREAK means do not break long lines into shorter lines.

(defun base64-encode-string (string &optional no-line-break)
  (DatatypeConverter/printBase64Binary (.getBytes (str string) "UTF-8")))

Return t if two Lisp objects have similar structure and contents. This is like `equal' except that it compares the text properties of strings. (`equal' ignores text properties.)

(defun equal-including-properties (o1 o2)
  (equal o1 o2))

Return a substring of STRING, without text properties. It starts at index FROM and ends before TO. TO may be nil or omitted; then the substring runs to the end of STRING. If FROM is nil or omitted, the substring starts at the beginning of STRING. If FROM or TO is negative, it counts from the end.

With one argument, just copy STRING without its properties.

(defun substring-no-properties (string &optional from to)
  (subs string (or from 0) (or to (count string))))
(def ^:private ^Random rnd (Random.))

Return a pseudo-random number. All integers representable in Lisp are equally likely. On most systems, this is 29 bits' worth. With positive integer LIMIT, return random number in interval [0,LIMIT). With argument t, set the random number seed from the current time and pid. Other values of LIMIT are ignored.

(defun random (&optional limit)
  (if (true? limit)
    (do
      (.setSeed rnd (System/currentTimeMillis))
      (random))
    (if ((every-pred integer? pos?) limit)
      (min (.nextLong rnd) (long limit))
      (.nextLong rnd))))

Concatenate all the arguments and make the result a string. The result is a string whose elements are the elements of all the arguments. Each argument may be a string or a list or vector of characters (integers).

(defun concat (&rest sequences)
  (apply str (map char (apply c/concat sequences))))

Return the number of bytes in STRING. If STRING is multibyte, this may be greater than the length of STRING.

(defun string-bytes (string)
  (count (.getBytes (str string))))

Return non-nil if KEY is `equal' to the car of an element of LIST. The value is actually the first element of LIST whose car equals KEY.

(defun assoc (key list)
  (some #(c/and (data/consp %) (equal key (car %)) %) (cons/maybe-seq list)))

Remove KEY from TABLE.

(defun remhash (key table)
  (.remove ^Map table key)
  nil)

Ask user a yes-or-no question. Return t if answer is yes. PROMPT is the string to display to ask the question. It should end in a space; `yes-or-no-p' adds "(yes or no) " to it.

The user must confirm the answer with RET, and can edit it until it has been confirmed.

Under a windowing system a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil.

(defun yes-or-no-p (prompt)
  ;; This doesn't work as minibuffer's doesn't, but we want to see if it happens.
  ((ns-resolve 'deuce.emacs.minibuf 'minibuffer) prompt)
  true)

Return the number of elements in TABLE.

(defun hash-table-count (table)
  (count table))

Clear the contents of STRING. This makes STRING unibyte and may change its length.

(defun clear-string (string))

Not tail recursive

(defn ^:private del [f elt list]
  (when list
    (if (f elt (car list))
      (del f elt (cdr list))
      (doto list
        (setcdr (del f elt (cdr list)))))))
(defn ^:private mem [f elt list]
  (loop [list list]
    (if (f elt (car list))
      list
      (when-let [list (cdr list)]
        (recur list)))))

Delete by side effect any occurrences of ELT as a member of LIST. The modified LIST is returned. Comparison is done with `eq'. If the first member of LIST is ELT, there is no way to remove it by side effect; therefore, write `(setq foo (delq element foo))' to be sure of changing the value of `foo'.

(defun delq (elt list)
  (del data/eq elt list))

Return non-nil if KEY is `eq' to the car of an element of LIST. The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored.

(defun assq (key list)
  (first (filter #(data/eq key (data/car-safe %)) (cons/maybe-seq list))))

Return the multibyte equivalent of STRING. If STRING is unibyte and contains non-ASCII characters, the function `unibyte-char-to-multibyte' is used to convert each unibyte character to a multibyte character. In this case, the returned string is a newly created string with no text properties. If STRING is multibyte or entirely ASCII, it is returned unchanged. In particular, when STRING is unibyte and entirely ASCII, the returned string is unibyte. (When the characters are all ASCII, Emacs primitives will treat the string the same way whether it is unibyte or multibyte.)

(defun string-make-multibyte (string)
  (string-to-multibyte string))

Return t if two strings have identical contents. Case is significant, but text properties are ignored. Symbols are also allowed; their print names are used instead.

(defun string-equal (s1 s2)
  (= (str s1) (str s2)))

Apply FUNCTION to each element of SEQUENCE, and make a list of the results. The result is a list just as long as SEQUENCE. SEQUENCE may be a list, a vector, a bool-vector, or a string.

(defun mapcar (function sequence)
  (el/check-type 'sequencep sequence)
  (apply alloc/list (map (el/fun function) (cons/maybe-seq sequence))))

Store each element of ARRAY with ITEM. ARRAY is a vector, string, char-table, or bool-vector.

(defun fillarray (array item)
  (if (instance? CharTable array)
    (fillarray (.contents ^CharTable array) item)
    (Arrays/fill ^objects array item))
  array)

Return list of 1 minute, 5 minute and 15 minute load averages.

Each of the three load averages is multiplied by 100, then converted to integer.

When USE-FLOATS is non-nil, floats will be used instead of integers. These floats are not multiplied by 100.

If the 5-minute or 15-minute load averages are not available, return a shortened list, containing only those averages which are available.

An error is thrown if the load average can't be obtained. In some cases making it work would require Emacs being installed setuid or setgid so that it can read kernel information, and that usually isn't advisable.

(defun load-average (&optional use-floats)
  (let [last-minute (.getSystemLoadAverage (ManagementFactory/getOperatingSystemMXBean))]
    (list (if use-floats last-minute (long (* 100 last-minute))))))

Base64-encode the region between BEG and END. Return the length of the encoded text. Optional third argument NO-LINE-BREAK means do not break long lines into shorter lines.

(defun base64-encode-region (beg end &optional no-line-break)
  (interactive "r"))

Return the weakness of TABLE.

(defun hash-table-weakness (table)
  nil)

Clear hash table TABLE and return it.

(defun clrhash (table)
  (empty table))

Concatenate all the arguments and make the result a vector. The result is a vector whose elements are the elements of all the arguments. Each argument may be a list, vector or string.

(defun vconcat (&rest sequences)
  (apply alloc/vector (apply c/concat sequences)))

Create and return a new hash table.

Arguments are specified as keyword/argument pairs. The following arguments are defined:

:test TEST -- TEST must be a symbol that specifies how to compare keys. Default is eql'. Predefined are the testseq', `eql', and `equal'. User-supplied test and hash functions can be specified via `define-hash-table-test'.

:size SIZE -- A hint as to how many elements will be put in the table. Default is 65.

:rehash-size REHASH-SIZE - Indicates how to expand the table when it fills up. If REHASH-SIZE is an integer, increase the size by that amount. If it is a float, it must be > 1.0, and the new size is the old size multiplied by that factor. Default is 1.5.

:rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0. Resize the hash table when the ratio (number of entries / table size) is greater than or equal to THRESHOLD. Default is 0.8.

:weakness WEAK -- WEAK must be one of nil, t, key',value', key-or-value', orkey-and-value'. If WEAK is not nil, the table returned is a weak table. Key/value pairs are removed from a weak hash table when there are no non-weak references pointing to their key, value, one of key or value, or both key and value, depending on WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK is nil.

(defun make-hash-table (&rest keyword-args)
  (let [{:keys [size rehash-threshold] :or {size 65 rehash-threshold 0.8}} (apply hash-map keyword-args)]
    (HashMap. size rehash-threshold)))

Return non-nil if KEY is `equal' to the cdr of an element of LIST. The value is actually the first element of LIST whose cdr equals KEY.

(defun rassoc (key list)
  (some #(c/and (data/consp %) (equal key (cdr %)) %) (cons/maybe-seq list)))

Return t if two Lisp objects have similar structure and contents. They must have the same data type. Conses are compared by comparing the cars and the cdrs. Vectors and strings are compared element by element. Numbers are compared by value, but integers cannot equal floats. (Use `=' if you want integers and floats to be able to be equal.) Symbols must match exactly.

(defun equal (o1 o2)
  (or (data/eq o1 o2)
      (if (and (seq? o1) (seq? o2))
        (c/and (equal (car o1) (car o2))
               (equal (cdr o1) (cdr o2)))
        (if (and (data/numberp o1) (data/numberp o2))
          (and (= (data/floatp o1) (data/floatp o2))
               (data/= o1 o2))
          (Objects/deepEquals o1 o2)))))
(declare reverse)

Reverse LIST by modifying cdr pointers. Return the reversed list.

(defun nreverse (list)
  (el/check-type 'listp list)
  (if (empty? list)
    list
    (loop [l list
           n (cdr list)
           r nil]
      (setcdr l r)
      (if (data/consp n)
        (recur n (cdr n) l)
        l))))

Reverse LIST, copying. Return the reversed list. See also the function `nreverse', which is used more often.

(defun reverse (list)
  (el/check-type 'listp list)
  (when-not (data/null list)
    (apply alloc/list (c/reverse (apply alloc/list list)))))

Take cdr N times on LIST, return the result.

(defun nthcdr (n list)
  (loop [n n list list]
    (if (pos? n)
      (recur (dec n) (cdr list))
      (cons/maybe-seq list))))

Return the current rehash size of TABLE.

(defun hash-table-rehash-size (table))

Store SYMBOL's PROPNAME property with value VALUE. It can be retrieved with `(get SYMBOL PROPNAME)'.

(defun put (symbol propname value)
  (swap! el/symbol-plists assoc-in [(el/sym symbol) propname] value)
  value)

Base64-decode the region between BEG and END. Return the length of the decoded text. If the region can't be decoded, signal an error and don't modify the buffer.

(defun base64-decode-region (beg end)
  (interactive "r"))

Return the Nth element of LIST. N counts from zero. If LIST is not that long, nil is returned.

(defun nth (n list)
  (cons/maybe-seq
   (if (pos? n)
     (c/nth (cons/maybe-seq list) n nil)
     (car list))))

Return a unibyte string with the same individual chars as STRING. If STRING is unibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties, where each `eight-bit' character is converted to the corresponding byte. If STRING contains a non-ASCII, non-`eight-bit' character, an error is signaled.

(defun string-to-unibyte (string)
  (string-as-unibyte string))

Concatenate any number of lists by altering them. Only the last argument is not altered, and need not be a list.

(defun nconc (&rest lists)
  (let [lists (map cons/maybe-seq (remove empty? lists))]
    (when (> (count lists) 1)
      (loop [ls (rest lists)
             last (cons/last-cons (first lists))]
        (setcdr last (first ls))
        (when (seq (rest ls))
          (recur (rest ls)
                 (cons/last-cons (first ls))))))
    (first lists)))

Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. If the string contains multibyte characters, this is not necessarily the number of bytes in the string; it is the number of characters. To get the number of bytes, use `string-bytes'.

(defun length (sequence)
  (el/check-type 'sequencep sequence)
  (cond
   (instance? CharTable sequence)
   (count (.contents ^CharTable sequence))
   (data/listp sequence)
   (loop [cons sequence
          length 0]
     (if (and (not (data/null cons)) (data/listp cons))
       (recur (cdr cons) (inc length))
       (do
         (el/check-type 'listp cons)
         length)))
   :else (count sequence)))

Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT.

(defun memq (elt list)
  (mem data/eq elt list))

Return non-nil if ELT is an element of LIST. Comparison done with `eql'. The value is actually the tail of LIST whose car is ELT.

(defun memql (elt list)
  (mem eql elt list))

Look up KEY in TABLE and return its associated value. If KEY is not found, return DFLT which defaults to nil.

(defun gethash (key table &optional dflt)
  (c/get table key dflt))

Return the argument unchanged.

(defun identity (arg)
  arg)

Define a new hash table test with name NAME, a symbol.

In hash tables created with NAME specified as test, use TEST to compare keys, and HASH for computing hash codes of keys.

TEST must be a function taking two arguments and returning non-nil if both arguments are the same. HASH must be a function taking one argument and return an integer that is the hash code of the argument. Hash code computation should use the whole value range of integers, including negative integers.

(defun define-hash-table-test (name test hash))

Return the size of TABLE. The size can be used as an argument to `make-hash-table' to create a hash table than can hold as many elements as TABLE holds without need for resizing.

(defun hash-table-size (table)
  (count table))
(declare featurep)

If feature FEATURE is not loaded, load it from FILENAME. If FEATURE is not a member of the list `features', then the feature is not loaded; so load the file FILENAME. If FILENAME is omitted, the printname of FEATURE is used as the file name, and load' will try to load this name appended with the suffix.elc' or `.el', in that order. The name without appended suffix will not be used. See `get-load-suffixes' for the complete list of suffixes. If the optional third argument NOERROR is non-nil, then return nil if the file is not found instead of signaling an error. Normally the return value is FEATURE. The normal messages at start and end of loading FILENAME are suppressed.

(defun require (feature &optional filename noerror)
  (when-not (featurep feature)
    (lread/load (or filename (name feature)) noerror true))
  feature)

Return the value of SYMBOL's PROPNAME property. This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.

(defun get (symbol propname)
  (get-in @el/symbol-plists [(el/sym symbol) propname]))

Extract a value from a property list, comparing with `equal'. PLIST is a property list, which is a list of the form (PROP1 VALUE1 PROP2 VALUE2...). This function returns the value corresponding to the given PROP, or nil if PROP is not one of the properties on the list.

(defun lax-plist-get (plist prop)
  (plist-get plist prop))

Call FUNCTION for all entries in hash table TABLE. FUNCTION is called with two arguments, KEY and VALUE.

(defun maphash (function table)
  (let [f (el/fun function)]
    (dorun (map #(f (key %) (val %)) table))
    nil))

Return non-nil if KEY is `eq' to the cdr of an element of LIST. The value is actually the first element of LIST whose cdr is KEY.

(defun rassq (key list)
  (first (filter #(data/eq key (data/cdr-safe %))  list)))

Return the unibyte equivalent of STRING. Multibyte character codes are converted to unibyte according to nonascii-translation-table' or, if that is nil,nonascii-insert-offset'. If the lookup in the translation table fails, this function takes just the low 8 bits of each character.

(defun string-make-unibyte (string)
  (string-to-unibyte string))

Return t if first arg string is less than second in lexicographic order. Case is significant. Symbols are also allowed; their print names are used instead.

(defun string-lessp (s1 s2)
  (neg? (compare (str s1) (str s2))))

In WIDGET, set PROPERTY to VALUE. The value can later be retrieved with `widget-get'.

(defun widget-put (widget property value))

Return a new string whose contents are a substring of STRING. The returned string consists of the characters between index FROM (inclusive) and index TO (exclusive) of STRING. FROM and TO are zero-indexed: 0 means the first character of STRING. Negative values are counted from the end of STRING. If TO is nil, the substring runs to the end of STRING.

The STRING argument may also be a vector. In that case, the return value is a new vector that contains the elements between index FROM (inclusive) and index TO (exclusive) of that vector argument.

(defun substring (string from &optional to)
  (let [idx #(if (neg? %) (+ % (count string)) %)]
    (subs string (idx from) (idx (or to (count string))))))

Return t if FEATURE is present in this Emacs.

Use this to conditionalize execution of lisp code based on the presence or absence of Emacs or environment extensions. Use `provide' to declare that a feature is available. This function looks at the value of the variable `features'. The optional argument SUBFEATURE can be used to check a specific subfeature of FEATURE.

(defun featurep (feature &optional subfeature)
  (boolean (some #{feature} globals/features)))

Return the current rehash threshold of TABLE.

(defun hash-table-rehash-threshold (table))

Change value in PLIST of PROP to VAL. PLIST is a property list, which is a list of the form (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object. If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects.

(defun plist-put (plist prop val)
  (if-let [rest (memq prop plist)]
    (do (setcar (cdr rest) val)
        plist)
    (nconc plist (alloc/list prop val))))

Associate KEY with VALUE in hash table TABLE. If KEY is already present in table, replace its current value with VALUE. In any case, return VALUE.

(defun puthash (key value table)
  (.put ^Map table key value)
  value)

Return the test TABLE uses.

(defun hash-table-test (table))

Apply FUNCTION to each element of SEQUENCE for side effects only. Unlike `mapcar', don't accumulate the results. Return SEQUENCE. SEQUENCE may be a list, a vector, a bool-vector, or a string.

(defun mapc (function sequence)
  (dorun (map (el/fun function) sequence))
  sequence)

Return non-nil if PLIST has the property PROP. PLIST is a property list, which is a list of the form (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol. Unlike `plist-get', this allows you to distinguish between a missing property and a property with the value nil. The value is actually the tail of PLIST whose car is PROP.

(defun plist-member (plist prop)
  ((plist-map plist) prop))

Sort LIST, stably, comparing elements using PREDICATE. Returns the sorted list. LIST is modified by side effects. PREDICATE is called with two elements of LIST, and should return non-nil if the first element should sort before the second.

(defun sort (list predicate)
  (let [f (el/fun predicate)]
    (apply alloc/list (c/sort (fn [x y] (if (f x y) -1 1)) (cons/maybe-seq list)))))

Base64-decode STRING and return the result.

(defun base64-decode-string (string)
  (String. (DatatypeConverter/parseBase64Binary string) "UTF-8"))
 
(ns deuce.emacs.data
  (:use [deuce.emacs-lisp :only (defun defvar setq setq-default) :as el])
  (:require [clojure.core :as c]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.globals :as globals]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs-lisp.cons :as cons]
            [taoensso.timbre :as timbre])
  (:import [java.nio ByteOrder]
           [java.io Writer]
           [java.lang.reflect Field]
           [clojure.lang Symbol Var])
  (:refer-clojure :exclude [+ * - / aset set < = > max >= <= mod atom min]))
(declare consp car cdr set-default default-boundp markerp)

The largest value that is representable in a Lisp integer.

(defvar most-positive-fixnum Long/MAX_VALUE)

The smallest value that is representable in a Lisp integer.

(defvar most-negative-fixnum Long/MIN_VALUE)
(def ^:private array-class (Class/forName "[Ljava.lang.Object;"))
(defmethod print-method array-class [o ^Writer w]
  (print-method (vec (cons/ellipsis o)) w))
(defmethod print-dup array-class [array ^Writer w]
  (.write w "#el/vec [")
  (dotimes [idx (count array)]
    (print-dup (aget ^objects array idx) w)
    (when-not (c/= idx (dec (count array)))
      (.write w " ")))
  (.write w "]"))
(defmethod print-dup Symbol [s ^Writer w]
  (if (and (re-find  #"([\\,/]|^\d|::|:$)" (name s)) (not= "/" (name s)))
    (.write w (str "#el/sym " (pr-str (name s))))
    (.write w (str s))))
(defrecord CharTable
    [;; /* This holds a default value,
     ;; which is used whenever the value for a specific character is nil.  */
     defalt
     ;; /* This points to another char table, which we inherit from when the
     ;; value for a specific character is nil.  The `defalt' slot takes
     ;; precedence over this.  */
     parent
     ;; /* This is a symbol which says what kind of use this char-table is
     ;; meant for.  */
     purpose
     contents ;[(1 << CHARTAB_SIZE_BITS_0)]
     ;; /* These hold additional data.  It is a vector.  */
     extras])
(defmethod print-method CharTable [^CharTable char-table ^Writer w]
  (.write w (str "#^" (vec (cons/ellipsis (concat [(.defalt char-table)
                                                   @(.parent char-table)
                                                   (.purpose char-table)]
                                                  (.contents char-table)))))))

struct buffer_text in buffer.h. Contains many other low level fields we hopefully won't need.

(defrecord BufferText
    [;; /* Actual address of buffer contents.  If REL_ALLOC is defined,
     ;;    this address might change when blocks are relocated which can
     ;;    e.g. happen when malloc is called.  So, don't pass a pointer
     ;;    into a buffer's text to functions that malloc.  */
     beg;
     ;; /* This counts buffer-modification events
     ;;    for this buffer.  It is incremented for
     ;;    each such event, and never otherwise
     ;;    changed.  */
     modiff
     ;;	/* Previous value of modiff, as of last
     ;;    time buffer visited or saved a file.  */
     save-modiff
     ;; /* The markers that refer to this buffer.
     ;;    This is actually a single marker ---
     ;;    successive elements in its marker `chain'
     ;;    are the other markers referring to this buffer.
     ;;    This is a singly linked unordered list, which means that it's
     ;;    very cheap to add a marker to the list and it's also very cheap
     ;;    to move a marker within a buffer.  */
     markers])

struct buffer in buffer.h. Pretty large, so won't move it all over at once. The buffer locals are specified with DEFVARPERBUFFER, and their defaults with DEFVARBUFFERDEFAULTS Thet're all already defined as globals in buffer.clj. We need to put them (with default value at create) on this guy somehow.

(defrecord Buffer
    [;; /* This structure holds the coordinates of the buffer contents
     ;;    in ordinary buffers.  In indirect buffers, this is not used.  */
     own-text
     ;; /* This points to the `struct buffer_text' that used for this buffer.
     ;;    In an ordinary buffer, this is the own_text field above.
     ;;    In an indirect buffer, this is the own_text field of another buffer.  */
     text
     ;; /* Char position of point in buffer.  */
     pt
     ;; /* Char position of beginning of accessible range.  */
     begv
     ;; /* Char position of end of accessible range.  */
     zv
     ;; /* The name of this buffer.  */
     name
     ;; /* "The mark".  This is a marker which may
     ;;    point into this buffer or may point nowhere.  */
     mark
     ;; /* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) for all
     ;;    per-buffer variables of this buffer.  For locally unbound
     ;;    symbols, just the symbol appears as the element.  */
     local-var-alist])
(defmethod print-method Buffer [^Buffer buffer ^Writer w]
  (.write w (str "#<buffer " @(.name buffer) ">")))

struct in buffer.h. Has many other fields, its also a linked list above. Attempting to use as a value object

(defrecord Marker
    [;; /* 1 means normal insertion at the marker's position
      ;;   leaves the marker after the inserted text.  */
     insertion-type
     ;; /* This is the buffer that the marker points into, or 0 if it points nowhere.
     ;;    Note: a chain of markers can contain markers pointing into different
     ;;    buffers (the chain is per buffer_text rather than per buffer, so it's
     ;;    shared between indirect buffers).  */
     ;; /* This is used for (other than NULL-checking):
     ;;    - Fmarker_buffer
     ;;    - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
     ;;    - unchain_marker: to find the list from which to unchain.
     ;;    - Fkill_buffer: to only unchain the markers of current indirect buffer.
     ;;    */
     buffer;
     ;; /* This is the char position where the marker points.  */
     charpos])
(defmethod print-method Marker [^Marker marker ^Writer w]
  (.write w (str "#<marker" (if (and @(.charpos marker) @(.buffer marker))
                              (str " at " @(.charpos marker) " in " @(.name ^Buffer @(.buffer marker)))
                              (str " in no buffer")) ">")))
(defrecord Frame
    [;; /* Name of this frame: a Lisp string.  It is used for looking up resources,
     ;;    as well as for the title in some cases.  */
     name
     ;; /* This frame's root window.  Every frame has one.
     ;;    If the frame has only a minibuffer window, this is it.
     ;;    Otherwise, if the frame has a minibuffer window, this is its sibling.  */
     root-window
     ;; /* This frame's selected window.
     ;;    Each frame has its own window hierarchy
     ;;    and one of the windows in it is selected within the frame.
     ;;    The selected window of the selected frame is Emacs's selected window.  */
     selected-window
     ;; /* This frame's minibuffer window.
     ;;    Most frames have their own minibuffer windows,
     ;;    but only the selected frame's minibuffer window
     ;;    can actually appear to exist.  */
     minibuffer-window
     ;; /* The terminal device that this frame uses.  If this is NULL, then
     ;;    the frame has been deleted. */
     terminal])
(defmethod print-method Frame [^Frame frame ^Writer w]
  (.write w (str "#<frame " (.name frame) " "
                 (format "0x%x" (System/identityHashCode frame)) ">")))
(defrecord Window
    [;; /* t if this window is a minibuffer window.  */
     mini-p
     ;; /* Following (to right or down) and preceding (to left or up) child
     ;;    at same level of tree.  */
     next prev
     ;; /* First child of this window: vchild is used if this is a vertical
     ;;    combination, hchild if this is a horizontal combination.  Of the
     ;;    fields vchild, hchild and buffer, one and only one is non-nil
     ;;    unless the window is dead.  */
     hchild
     vchild
     ;; /* The window this one is a child of.  */
     parent
     ;; /* The upper left corner coordinates of this window, as integers
     ;;    relative to upper left corner of frame = 0, 0.  */
     left-col
     top-line
     ;; /* The size of the window.  */
     total-lines
     total-cols
     ;; /* The normal size of the window.  */
     normal-lines
     normal-cols
     ;; /* The buffer displayed in this window.  Of the fields vchild,
     ;;    hchild and buffer, one and only one is non-nil unless the window
     ;;    is dead.  */
     buffer
     ;; /* A marker pointing to where in the text to start displaying.
     ;;    BIDI Note: This is the _logical-order_ start, i.e. the smallest
     ;;    buffer position visible in the window, not necessarily the
     ;;    character displayed in the top left corner of the window.  */
     start
     ;; /* A marker pointing to where in the text point is in this window,
     ;;    used only when the window is not selected.
     ;;    This exists so that when multiple windows show one buffer
     ;;    each one can have its own value of point.  */
     pointm
     ;; /* Unique number of window assigned when it was created.  */
     sequence-number])
(defmethod print-method Window [^Window window ^Writer w]
  (.write w (str "#<window " (.sequence-number window)
                 (when-let [buffer ^Buffer @(.buffer window)]
                   (str " on " @(.name buffer))) ">")))
(defn ^:private coerce-number [x]
  (el/check-type 'number-or-marker-p
   (cond
     (char? x) (int x)
     (markerp x) @(.charpos ^Marker x)
     :else x)))
(defn ^:private coerce-numbers [xs]
  (map coerce-number xs))

Return t if OBJECT is a nonnegative integer.

(defun natnump (object)
  ((every-pred integer? (complement neg?)) object))

Return t if OBJECT is a marker (editor pointer).

(defun markerp (object)
  (instance? Marker object))

Return VALUE with its bits shifted left by COUNT. If COUNT is negative, shifting is actually to the right. In this case, the sign bit is duplicated.

(defun ash (value count)
  (if (pos? count)
    (bit-shift-left value count)
    (bit-shift-right value (c/- count))))

Return a symbol representing the type of OBJECT. The symbol returned names the object's basic type; for example, (type-of 1) returns `integer'.

(defun type-of (object)
  (type object))
(declare symbol-function symbolp eq)

Navgeet's additions, not sure they've been tested against real world scenarios.

(defn ^:private indirect_function [object]
  (loop [hare object
         tortoise object]
    (if (symbolp hare)
      (let [hare1 (symbol-function hare)]
        (if (symbolp hare1)
          (let [hare2 (symbol-function hare1)
                tortoise1 (symbol-function tortoise)]
            (if (eq hare2 tortoise1)
              (el/throw 'cyclic-function-indirection '(object))
              (recur hare2 tortoise1)))
          hare1))
      hare)))

Return the function at the end of OBJECT's function chain. If OBJECT is not a symbol, just return it. Otherwise, follow all function indirections to find the final function binding and return it. If the final symbol in the chain is unbound, signal a void-function error. Optional arg NOERROR non-nil means to return nil instead of signaling. Signal a cyclic-function-indirection error if there is a loop in the function chain of symbols.

(defun indirect-function (object &optional noerror)
  (if (symbolp object)
    (el/try-with-tag
      (let [result (symbol-function object)]
        ;; Optimize for no indirection.
        (if (symbolp result)
          (indirect_function result)
          result))
      (catch 'void-function e
        (if noerror nil (throw e))))
    object))

Return SYMBOL's name, a string.

(defun symbol-name (symbol)
  (el/check-type 'symbolp symbol)
  (condp some [symbol]
    keyword? (str symbol)
    symbol? (name symbol)
    true? "true"
    nil? (pr-str nil)))

Make SYMBOL's value be void. Return SYMBOL.

(defun makunbound (symbol)
  (ns-unmap 'deuce.emacs-lisp.globals (el/sym symbol))
  symbol)

Return the interactive form of CMD or nil if none. If CMD is not a command, the return value is nil. Value, if non-nil, is a list (interactive SPEC).

(defun interactive-form (cmd))

Return bitwise-or of all the arguments. Arguments may be integers, or markers converted to integers.

(defun logior (&rest ints-or-markers)
  (apply bit-or (coerce-numbers ints-or-markers)))
(declare arrayp listp)

Return t if OBJECT is a sequence (list or array).

(defun sequencep (object)
  ((some-fn sequential? arrayp listp) object))

Return t if NUMBER is zero.

(defun zerop (number)
  (zero? number))
(declare symbol-value)

Return the variable at the end of OBJECT's variable chain. If OBJECT is a symbol, follow all variable indirections and return the final variable. If OBJECT is not a symbol, just return it. Signal a cyclic-variable-indirection error if there is a loop in the variable chain of symbols.

(defun indirect-variable (object)
  (symbol-value object))

Return SYMBOL's value. Error if that is void.

(defun symbol-value (symbol)
  (el/check-type 'symbolp symbol)
  (el/el-var-get* symbol))

Return t if OBJECT is a keyword. This means that it is a symbol with a print name beginning with `:' interned in the initial obarray.

(defun keywordp (object)
  (keyword? object))

Return NUMBER plus one. NUMBER may be a number or a marker. Markers are converted to integers.

(defun #el/sym "1+" (number)
  (inc (coerce-number number)))

Return t if OBJECT is a built-in function.

(defun subrp (object)
  (and (fn? object)
       (-> object meta :ns)
       (not= (the-ns 'deuce.emacs) (-> object meta :ns))))

Return SYMBOL's property list.

(defun symbol-plist (symbol)
  (cons/maybe-seq (map #(cons/pair (key val) (val %)) (@el/symbol-plists 'symbol))))

Return t if OBJECT is a string.

(defun stringp (object)
  (string? object))

Return t if OBJECT is an integer.

(defun integerp (object)
  ((some-fn integer? char?) object))

Return t if SYMBOL's function definition is not void.

(defun fboundp (symbol)
  (when-let [v (and symbol (el/fun symbol))]
    (bound? v)))

Return remainder of X divided by Y. Both must be integers or markers.

(defun % (x y)
  (rem x y))

Return sum of any number of arguments, which are numbers or markers.

(defun + (&rest numbers-or-markers)
  (apply c/+ (coerce-numbers numbers-or-markers)))

Return VALUE with its bits shifted left by COUNT. If COUNT is negative, shifting is actually to the right. In this case, zeros are shifted in on the left.

(defun lsh (value count)
  (if (pos? count)
    (bit-shift-left value count)
    (bit-shift-right value (c/- count))))
(declare null)

Return t if the two args are the same Lisp object.

(defun eq (obj1 obj2)
  (cond
   (null obj1) (null obj2)
    ;; Macros can get confused by the exact namespace
   (and (symbol? obj1) (symbol? obj2)) (c/= (name obj1) (name obj2))
   (and (char? obj1) (char? obj2)) (c/= (coerce-number obj1) (coerce-number obj2))
   :else (identical? obj1 obj2)))

Return product of any number of arguments, which are numbers or markers.

(defun * (&rest numbers-or-markers)
  (apply c/* (coerce-numbers numbers-or-markers)))

Negate number or subtract numbers or markers and return the result. With one arg, negates it. With more than one arg, subtracts all but the first from the first.

(defun - (&optional number-or-marker &rest more-numbers-or-markers)
  (apply c/- (coerce-numbers (c/cons number-or-marker more-numbers-or-markers))))

Return t if OBJECT is a multibyte string.

(defun multibyte-string-p (object)
  (string? object))

Return bitwise-exclusive-or of all the arguments. Arguments may be integers, or markers converted to integers.

(defun logxor (&rest ints-or-markers)
  (apply c/bit-xor (coerce-numbers ints-or-markers))  )

Return t if OBJECT is a floating point number.

(defun floatp (object)
  (float? object))

Return t if OBJECT is a number or a marker.

(defun number-or-marker-p (object)
  ((some-fn number? markerp) object))

Return the cdr of OBJECT if it is a cons cell, or else nil.

(defun cdr-safe (object)
  (when (consp object)
    (cdr object)))

Return first argument divided by all the remaining arguments. The arguments must be numbers or markers.

(defun / (dividend divisor &rest divisors)
  (if (zero? divisor)
    (el/throw 'arith-error nil)
    (c/reduce / (c/let [r (c/apply clojure.core// (coerce-numbers [dividend divisor]))]
                  (if (ratio? r) (long r) r))
              (coerce-numbers divisors))))

Return the byteorder for the machine. Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII lowercase l) for small endian machines.

(defun byteorder ()
  ({ByteOrder/BIG_ENDIAN "B"
    ByteOrder/LITTLE_ENDIAN "l"}
   (ByteOrder/nativeOrder)))

Return name of subroutine SUBR. SUBR must be a built-in function.

(defun subr-name (subr)
  (-> subr meta :name))

Make VARIABLE have a separate value in the current buffer. Other buffers will continue to share a common default value. (The buffer-local value of VARIABLE starts out as the same value VARIABLE previously had. If VARIABLE was void, it remains void.) Return VARIABLE.

If the variable is already arranged to become local when set, this function causes a local value to exist for this buffer, just as setting the variable would do.

This function returns VARIABLE, and therefore (set (make-local-variable 'VARIABLE) VALUE-EXP) works.

See also `make-variable-buffer-local'.

Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument.

(defun make-local-variable (variable)
  (interactive "vMake Local Variable: ")
  (let [buffer-locals (.local-var-alist ^Buffer ((el/fun 'current-buffer)))]
    (when-not (contains? @buffer-locals variable)
      (swap! buffer-locals assoc variable (Var/create)))
    variable))

Return t if OBJECT is a number (floating point or integer).

(defun numberp (object)
  ((some-fn number? integerp) object))

Return bitwise-and of all the arguments. Arguments may be integers, or markers converted to integers.

(defun logand (&rest ints-or-markers)
  (apply c/bit-and (coerce-numbers ints-or-markers)))

Return t if OBJECT is a cons cell.

(defun consp (object)
  (cons/consp object))

Return t if OBJECT is a list, that is, a cons cell or nil. Otherwise, return nil.

(defun listp (object)
  (cons/listp object))

Return the element of ARRAY at index IDX. ARRAY may be a vector, a string, a char-table, a bool-vector, or a byte-code object. IDX starts at 0.

(defun aref (array idx)
  (if (instance? CharTable array)
    (aref (.contents ^CharTable array) (int idx))
    (get array idx)))

Return t if OBJECT is a nonnegative integer.

(defun wholenump (object)
  ((every-pred integer? pos?) (coerce-number object)))

We probably don't want to do this due to interned strings.

(def ^:private string-chars (doto (.getDeclaredField String "value")
                                     (.setAccessible true)))

Store into the element of ARRAY at index IDX the value NEWELT. Return NEWELT. ARRAY may be a vector, a string, a char-table or a bool-vector. IDX starts at 0.

(defun aset (array idx newelt)
  (if (instance? CharTable array)
    (aset (.contents ^CharTable array) idx newelt)
    (if (string? array)
      (do (timbre/warn "modifying String" (str "\"" array "\""))
        (c/aset ^chars (.get ^Field string-chars array) idx (char newelt)))
      (c/aset ^objects array idx newelt))))
(declare vectorp char-table-p)

Return t if OBJECT is an array (string or vector).

(defun arrayp (object)
  ((some-fn vectorp stringp char-table-p) object))

Return t if OBJECT is a vector.

(defun vectorp (object)
  (c/= array-class (type object)))

Make SYMBOL's function definition be void. Return SYMBOL.

(defun fmakunbound (symbol)
  (when-let [fun (el/fun (el/sym symbol))]
    (ns-unmap (-> (el/fun symbol) meta :ns) (el/sym symbol)))
  symbol)

Return the bitwise complement of NUMBER. NUMBER must be an integer.

(defun lognot (number)
  (bit-not (coerce-number number)))
(declare atom)

Set the cdr of CELL to be NEWCDR. Returns NEWCDR.

(defun setcdr (cell newcdr)
  (el/check-type 'consp cell)
  (cons/setcdr cell (cons/maybe-seq newcdr)))

Set SYMBOL's value to NEWVAL, and return NEWVAL.

(defun set (symbol newval)
  (el/check-type 'symbolp symbol)
  (if (c/= symbol (c/symbol ""))
    nil ;; Hack for anonymous symbol used by abbrev.el, needs proper fix.
    (el/el-var-set* symbol newval)))

Return t if first arg is less than second arg. Both must be numbers or markers.

(defun < (num1 num2)
  (c/< (coerce-number num1) (coerce-number num2)))

Return the car of OBJECT if it is a cons cell, or else nil.

(defun car-safe (object)
  (when (consp object)
    (car object)))

Set SYMBOL's function definition to DEFINITION, and return DEFINITION.

(defun fset (symbol definition)
  (el/check-type 'symbolp symbol)
  (let [symbol (el/sym symbol)
        sym (el/fun symbol)]
    ;; Navgeet's additions, not sure they've been tested against real world scenarios.
    (when sym
      (when (and (consp @sym) (c/= (car @sym) 'autoload))
        ;; Creates a cyclic load dependency chain.
        ;; TODO: deuce.emacs.fns/put must be below deuce.emacs.data
        ;; (fns/put symbol 'autoload (cdr @sym))))
    (ns-unmap 'deuce.emacs symbol)
    (intern 'deuce.emacs symbol definition)
    definition))

Return the cdr of LIST. If arg is nil, return nil. Error if arg is not nil and not a cons cell. See also `cdr-safe'.

See Info node `(elisp)Cons Cells' for a discussion of related basic Lisp concepts such as cdr, car, cons cell and list.

(defun cdr (list)
  (el/check-type 'listp list)
  (cons/cdr (cons/maybe-seq list)))

Return t if two args, both numbers or markers, are equal.

(defun = (num1 num2)
  (== (coerce-number num1) (coerce-number num2)))

Make VARIABLE become buffer-local whenever it is set. At any time, the value for the current buffer is in effect, unless the variable has never been set in this buffer, in which case the default value is in effect. Note that binding the variable with `let', or setting it while a `let'-style binding made in this buffer is in effect, does not make the variable buffer-local. Return VARIABLE.

In most cases it is better to use `make-local-variable', which makes a variable local in just one buffer.

The function default-value' gets the default value andset-default' sets it.

(defun make-variable-buffer-local (variable)
  (interactive "vMake Variable Buffer Local: ")
  (when-not (default-boundp variable)
    (set-default variable nil))
  (swap! el/buffer-locals conj variable)
  variable)

Return t if OBJECT is a character or a string.

(defun char-or-string-p (object)
  ((some-fn char? integer? string?) object))

Return t if OBJECT is a char-table or vector.

(defun vector-or-char-table-p (object)
  ((some-fn vectorp char-table-p) object))

Return t if OBJECT is an editor buffer.

(defun bufferp (object)
  (instance? Buffer object))

Return t if first arg is greater than second arg. Both must be numbers or markers.

(defun > (num1 num2)
  (c/> (coerce-number num1) (coerce-number num2)))

Return largest of all the arguments (which must be numbers or markers). The value is always a number; markers are converted to numbers.

(defun max (number-or-marker &rest numbers-or-markers)
  (apply c/max number-or-marker numbers-or-markers))
(declare local-variable-p)

Non-nil if VARIABLE will be local in buffer BUFFER when set there. More precisely, this means that setting the variable (with set' orsetq'), while it does not have a `let'-style binding that was made in BUFFER, will produce a buffer local binding. See Info node `(elisp)Creating Buffer-Local'. BUFFER defaults to the current buffer.

(defun local-variable-if-set-p (variable &optional buffer)
  (when (or (contains? @el/buffer-locals variable)
            (local-variable-p variable buffer))
    true))

Return t if SYMBOL has a non-void default value. This is the value that is seen in buffers that do not have their own values for this variable.

(defun default-boundp (symbol)
  (or (nil? symbol)
      (when-let [^Var v (el/global symbol)]
        (.hasRoot v))))

Return t if OBJECT is not a list. Lists include nil.

(defun nlistp (object)
  ((complement listp) object))

Return t if first arg is greater than or equal to second arg. Both must be numbers or markers.

(defun >= (num1 num2)
  (c/>= (coerce-number num1) (coerce-number num2)))

Return t if SYMBOL's value is not void.

(defun boundp (symbol)
  (or (nil? symbol)
      (when-let [v (el/el-var symbol)]
        (bound? v))))

Return SYMBOL's default value. This is the value that is seen in buffers that do not have their own values for this variable. The default value is meaningful for variables with local bindings in certain buffers.

(defun default-value (symbol)
  (if-let [^Var v (el/global symbol)]
    (.getRawRoot v)
    (el/throw* 'void-variable (list symbol))))

Set the car of CELL to be NEWCAR. Returns NEWCAR.

(defun setcar (cell newcar)
  (el/check-type 'consp cell)
  (cons/setcar cell (cons/maybe-seq newcar)))

Return t if OBJECT is a symbol.

(defun symbolp (object)
  (or ((some-fn symbol? keyword? nil? true?) object)
      (and (seq? object) (c/= `deref (first object)) (symbolp (second object)))))

Return t if first arg is less than or equal to second arg. Both must be numbers or markers.

(defun <= (num1 num2)
  (c/<= (coerce-number num1) (coerce-number num2)))

Non-nil if VARIABLE has a local binding in buffer BUFFER. BUFFER defaults to the current buffer.

(defun local-variable-p (variable &optional buffer)
  (let [buffer-locals @(.local-var-alist ^Buffer (el/check-type 'bufferp (or buffer ((el/fun 'current-buffer)))))]
    (when (contains? buffer-locals variable)
      true)))

Return t if OBJECT is a byte-compiled function object.

(defun byte-code-function-p (object)
  (fn? object))

Set SYMBOL's function definition to DEFINITION, and return DEFINITION. Associates the function with the current load file, if any. The optional third argument DOCSTRING specifies the documentation string for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string determined by DEFINITION.

(defun defalias (symbol definition &optional docstring)
  (let [lambda? (fn? definition)
        f (and (or lambda? (symbol? definition))  ;; guard against value
               (el/fun definition))]
    (when-let [alias (if-not lambda?
                       (fn alias [&form &env & args] ;; Note implicit macro args
                         `(el/progn (~(el/fun definition) ~@args)))
                       definition)]
      (ns-unmap 'deuce.emacs symbol)
      (el/defvar-helper* 'deuce.emacs symbol alias (str symbol " is an alias for `" definition "'.\n\n"
                                                        (or docstring
                                                            (-> f meta :doc)
                                                            (-> definition meta :doc))))
      (alter-meta! (el/fun symbol) assoc :alias definition)
      (when-not lambda? (.setMacro ^Var (ns-resolve 'deuce.emacs symbol)))
      ;; We want this, but it currently wrecks havoc due to backquote
      ;; (when (and lambda? (-> definition meta :macro)))
      ;;   (.setMacro (el/fun symbol)))))
    definition))

Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.

(defun setplist (symbol newplist)
  (swap! el/symbol-plists assoc symbol (into {} (map #(vector (car %) (cdr %)) newplist)))
  newplist)

Set SYMBOL's default value to VALUE. SYMBOL and VALUE are evaluated. The default value is seen in buffers that do not have their own values for this variable.

(defun set-default (symbol value)
  (el/check-type 'symbolp symbol)
  (el/el-var-set-default* symbol value))

Return SYMBOL's function definition. Error if that is void.

(defun symbol-function (symbol)
  (el/check-type 'symbolp symbol)
  (if-let [f (el/fun symbol)] ;; This should probably not use el/fun, as you can store keymaps and what not as functions.
    (if (var? f) (el/fun f) f) ;; See binding/mode-specific-command-prefix
    (el/throw 'void-function symbol)))

Make VARIABLE no longer have a separate value in the current buffer. From now on the default value will apply in this buffer. Return VARIABLE.

(defun kill-local-variable (variable)
  (interactive "vKill Local Variable: ")
  (let [buffer-locals (.local-var-alist ^Buffer ((el/fun 'current-buffer)))]
    (swap! buffer-locals dissoc variable)
    variable))

Return the car of LIST. If arg is nil, return nil. Error if arg is not nil and not a cons cell. See also `car-safe'.

See Info node `(elisp)Cons Cells' for a discussion of related basic Lisp concepts such as car, cdr, cons cell and list.

(defun car (list)
  (el/check-type 'listp list)
  (cons/maybe-seq (cons/car list)))

Return t if OBJECT is a bool-vector.

(defun bool-vector-p (object))

Return minimum and maximum number of args allowed for SUBR. SUBR must be a built-in function. The returned value is a pair (MIN . MAX). MIN is the minimum number of args. MAX is the maximum number or the symbol `many', for a function with &rest' args, orunevalled' for a special form.

(defun subr-arity (subr)
  (-> subr meta :arglists first count))

Return X modulo Y. The result falls between zero (inclusive) and Y (exclusive). Both X and Y must be numbers or markers.

(defun mod (x y)
  (c/mod x y))

Return NUMBER minus one. NUMBER may be a number or a marker. Markers are converted to integers.

(defun #el/sym "1-" (number)
  (dec (coerce-number number)))

Return t if OBJECT is not a cons cell. This includes nil.

(defun atom (object)
  (not (consp object)))

Return t if OBJECT is nil.

(defun null (object)
  (when (or (nil? object) (c/= () object) (false? object))
    true))

Return t if OBJECT is a char-table.

(defun char-table-p (object)
  (instance? CharTable object))

This function is obsolete since 22.2; explicitly check for a frame-parameter instead.

Enable VARIABLE to have frame-local bindings. This does not create any frame-local bindings for VARIABLE, it just makes them possible.

A frame-local binding is actually a frame parameter value. If a frame F has a value for the frame parameter named VARIABLE, that also acts as a frame-local binding for VARIABLE in F-- provided this function has been called to enable VARIABLE to have frame-local bindings at all.

The only way to create a frame-local binding for VARIABLE in a frame is to set the VARIABLE frame parameter of that frame. See `modify-frame-parameters' for how to set frame parameters.

Note that since Emacs 23.1, variables cannot be both buffer-local and frame-local any more (buffer-local bindings used to take precedence over frame-local bindings).

(defun make-variable-frame-local (variable)
  (interactive "vMake Variable Frame Local: "))

Return the decimal representation of NUMBER as a string. Uses a minus sign if negative. NUMBER may be an integer or a floating point number.

(defun number-to-string (number)
  (str number))

Return t if OBJECT is an integer or a marker (editor pointer).

(defun integer-or-marker-p (object)
  ((some-fn integerp markerp) object))

Return smallest of all the arguments (which must be numbers or markers). The value is always a number; markers are converted to numbers.

(defun min (number-or-marker &rest numbers-or-markers)
  (apply c/min number-or-marker numbers-or-markers))

Parse STRING as a decimal number and return the number. This parses both integers and floating point numbers. It ignores leading spaces and tabs, and all trailing chars.

If BASE, interpret STRING as a number in that base. If BASE isn't present, base 10 is used. BASE must be between 2 and 16 (inclusive). If the base used is not 10, STRING is always parsed as integer.

(defun string-to-number (string &optional base)
  (try
    (long (BigInteger. (str string) (int (or base 10))))
    (catch NumberFormatException _
      (Double/parseDouble string))))

Return a value indicating where VARIABLE's current binding comes from. If the current binding is buffer-local, the value is the current buffer. If the current binding is frame-local, the value is the selected frame. If the current binding is global (the default), the value is nil.

(defun variable-binding-locus (variable))
 
(ns deuce.emacs.callproc
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [clojure.java.io :as io]
            [clojure.java.shell :as sh]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns])
  (:import [java.io File])
  (:refer-clojure :exclude []))

Directory containing the DOC file that comes with GNU Emacs. This is usually the same as `data-directory'.

(defvar doc-directory "etc/")

Directory of score files for games which come with GNU Emacs. If this variable is nil, then Emacs is unable to use a shared directory.

(defvar shared-game-score-directory nil)

*List of suffixes to try to find executable file names. Each element is a string.

(defvar exec-suffixes '(""))

*File name to load inferior shells from. Initialized from the SHELL environment variable, or to a system-dependent default if SHELL is not set.

You can customize this variable.

(defvar shell-file-name (System/getenv "SHELL"))

*List of directories to search programs to run in subprocesses. Each element is a string (directory name) or nil (try default directory).

You can customize this variable.

(defvar exec-path (apply list (.split (System/getenv "PATH") File/pathSeparator)))

List of environment variables inherited from the parent process. Each element should be a string of the form ENVVARNAME=VALUE. The elements must normally be decoded (using `locale-coding-system') for use.

(defvar initial-environment (apply list (map str (System/getenv))))

Directory of machine-independent files that come with GNU Emacs. These are files intended for Emacs to use while it runs.

(defvar data-directory "etc/")

List of overridden environment variables for subprocesses to inherit. Each element should be a string of the form ENVVARNAME=VALUE.

Entries in this list take precedence to those in the frame-local environments. Therefore, let-binding `process-environment' is an easy way to temporarily change the value of an environment variable, irrespective of where it comes from. To use `process-environment' to remove an environment variable, include only its name in the list, without "=VALUE".

This variable is set to nil when Emacs starts.

If multiple entries define the same variable, the first one always takes precedence.

Non-ASCII characters are encoded according to the initial value of `locale-coding-system', i.e. the elements must normally be decoded for use.

See setenv' andgetenv'.

(defvar process-environment (apply list (map (partial s/join "=") (into {} (System/getenv)))))

Directory for executables for Emacs to invoke. More generally, this includes any architecture-dependent files that are built and installed from the Emacs distribution.

(defvar exec-directory nil)

For internal use by the build procedure only. This is the name of the directory in which the build procedure installed Emacs's info files; the default value for `Info-default-directory-list' includes this.

(defvar configure-info-directory "/use/share/info")

Get the value of environment variable VARIABLE. VARIABLE should be a string. Value is nil if VARIABLE is undefined in the environment. Otherwise, value is a string.

This function searches `process-environment' for VARIABLE.

If optional parameter ENV is a list, then search this list instead of `process-environment', and return t when encountering a negative entry (an entry for a variable with no value).

(defun getenv-internal (variable &optional env)
  (if-not env
    (System/getenv variable)
    (throw (IllegalArgumentException. "doesn't yet support env argument"))))

Send text from START to END to a synchronous process running PROGRAM. The remaining arguments are optional. Delete the text if fourth arg DELETE is non-nil.

Insert output in BUFFER before point; t means current buffer; nil for BUFFER means discard it; 0 means discard and don't wait; and `(:file FILE)', where FILE is a file name string, means that it should be written to that file (if the file already exists it is overwritten). BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. STDERR-FILE may be nil (discard standard error output), t (mix it with ordinary output), or a file name string.

Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted. Remaining args are passed to PROGRAM at startup as command args.

If BUFFER is 0, `call-process-region' returns immediately with value nil. Otherwise it waits for PROGRAM to terminate and returns a numeric exit status or a signal description string. If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.

(defun call-process-region (start end program &optional delete buffer display &rest args))

Call PROGRAM synchronously in separate process. The remaining arguments are optional. The program's input comes from file INFILE (nil means `/dev/null'). Insert output in BUFFER before point; t means current buffer; nil for BUFFER means discard it; 0 means discard and don't wait; and `(:file FILE)', where FILE is a file name string, means that it should be written to that file (if the file already exists it is overwritten). BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, REAL-BUFFER says what to do with standard output, as above, while STDERR-FILE says what to do with standard error in the child. STDERR-FILE may be nil (discard standard error output), t (mix it with ordinary output), or a file name string.

Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. Remaining arguments are strings passed as command arguments to PROGRAM.

If executable PROGRAM can't be found as an executable, `call-process' signals a Lisp error. `call-process' reports errors in execution of the program only through its return and output.

If BUFFER is 0, `call-process' returns immediately with value nil. Otherwise it waits for PROGRAM to terminate and returns a numeric exit status or a signal description string. If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.

(defun call-process (program &optional infile buffer display &rest args)
  (let [opts (if infile [:in (io/file infile)] [])
        no-wait? (= 0 buffer)
        buffer (or no-wait?
                   (and (data/consp buffer) (= :file (data/car buffer)) (data/cdr buffer))
                   (and (true? buffer) (buffer/current-buffer))
                   (el/check-type 'bufferp (or (when (data/consp buffer) (data/car buffer))
                                               buffer (buffer/current-buffer))))
        stderr (when (data/consp buffer) (data/cdr buffer))
        runner (if no-wait? #(do (future-call %) nil) #(%))]
    (runner #(let [{:keys [exit out err]}
                   (apply sh/sh (concat (cons program args) opts))]
               (when (data/bufferp buffer)
                 (binding [buffer/*current-buffer* buffer]
                   (editfns/insert out)
                   (when (true? stderr)
                     (editfns/insert err))))
               (when (string? buffer)
                 (spit (io/file buffer) out))
               (when (string? stderr)
                 (spit (io/file stderr) err))
               exit))))
 
(ns deuce.emacs.bytecode
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Function used internally in byte-compiled code. The first argument, BYTESTR, is a string of byte code; the second, VECTOR, a vector of constants; the third, MAXDEPTH, the maximum stack depth used in this function. If the third argument is incorrect, Emacs may crash.

(defun byte-code (bytestr vector maxdepth))
 
(ns deuce.emacs.ccl
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Vector of code conversion maps.

(defvar code-conversion-map-vector nil)

Alist of fontname patterns vs corresponding CCL program. Each element looks like (REGEXP . CCL-CODE), where CCL-CODE is a compiled CCL program. When a font whose name matches REGEXP is used for displaying a character, CCL-CODE is executed to calculate the code point in the font from the charset number and position code(s) of the character which are set in CCL registers R0, R1, and R2 before the execution. The code point in the font is set in CCL registers R1 and R2 when the execution terminated. If the font is single-byte font, the register R2 is not used.

(defvar font-ccl-encoder-alist nil)

Vector containing all translation hash tables ever defined. Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls to `define-translation-hash-table'. The vector is indexed by the table id used by CCL.

(defvar translation-hash-table-vector nil)

Register CCL program CCL-PROG as NAME in `ccl-program-table'. CCL-PROG should be a compiled CCL program (vector), or nil. If it is nil, just reserve NAME as a CCL program name. Return index number of the registered CCL program.

(defun register-ccl-program (name ccl-prog))

Execute CCL-PROGRAM with registers initialized by REGISTERS.

CCL-PROGRAM is a CCL program name (symbol) or compiled code generated by `ccl-compile' (for backward compatibility. In the latter case, the execution overhead is bigger than in the former). No I/O commands should appear in CCL-PROGRAM.

REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value for the Nth register.

As side effect, each element of REGISTERS holds the value of the corresponding register after the execution.

See the documentation of `define-ccl-program' for a definition of CCL programs.

(defun ccl-execute (ccl-prog reg))

Return t if OBJECT is a CCL program name or a compiled CCL program code. See the documentation of `define-ccl-program' for the detail of CCL program.

(defun ccl-program-p (object))

Register SYMBOL as code conversion map MAP. Return index number of the registered map.

(defun register-code-conversion-map (symbol map))

Execute CCL-PROGRAM with initial STATUS on STRING.

CCL-PROGRAM is a symbol registered by `register-ccl-program', or a compiled code generated by `ccl-compile' (for backward compatibility, in this case, the execution is slower).

Read buffer is set to STRING, and write buffer is allocated automatically.

STATUS is a vector of [R0 R1 ... R7 IC], where R0..R7 are initial values of corresponding registers, IC is the instruction counter specifying from where to start the program. If R0..R7 are nil, they are initialized to 0. If IC is nil, it is initialized to head of the CCL program.

If optional 4th arg CONTINUE is non-nil, keep IC on read operation when read buffer is exhausted, else, IC is always set to the end of CCL-PROGRAM on exit.

It returns the contents of write buffer as a string, and as side effect, STATUS is updated. If the optional 5th arg UNIBYTE-P is non-nil, the returned string is a unibyte string. By default it is a multibyte string.

See the documentation of `define-ccl-program' for the detail of CCL program.

(defun ccl-execute-on-string (ccl-program status string &optional continue unibyte-p))
 
(ns deuce.emacs.buffer
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [clojure.java.io :as io]
            [flatland.ordered.map :as ordered-map]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.data :as data]
            [deuce.emacs.eval :as eval]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.cons :as cons]
            [deuce.emacs-lisp.globals :as globals])
  (:import [deuce.emacs.data Buffer BufferText Marker]
           [clojure.lang Var]
           [java.io PushbackReader])
  (:refer-clojure :exclude []))

List of functions to call before each text change. Two arguments are passed to each function: the positions of the beginning and end of the range of old text to be changed. (For an insertion, the beginning and end are at the same place.) No information is given about the length of the text after the change.

Buffer changes made while executing the `before-change-functions' don't call any before-change or after-change functions. That's because `inhibit-modification-hooks' is temporarily set non-nil.

If an unhandled error happens in running these functions, the variable's value remains nil. That prevents the error from happening repeatedly and making Emacs nonfunctional.

(defvar before-change-functions nil)

Default value of `ctl-arrow' for buffers that do not override it. This is the same as (default-value 'ctl-arrow).

(defvar default-ctl-arrow nil)

Hook to be run (by `run-hooks', which see) when a buffer is killed. The buffer being killed will be current while the hook is running. See `kill-buffer'.

(defvar kill-buffer-hook nil)

Default value of `line-spacing' for buffers that don't override it. This is the same as (default-value 'line-spacing).

(defvar default-line-spacing nil)

Non-nil if Transient Mark mode is enabled. See the command `transient-mark-mode' for a description of this minor mode.

Non-nil also enables highlighting of the region whenever the mark is active. The variable `highlight-nonselected-windows' controls whether to highlight all windows or just the selected window.

Lisp programs may give this variable certain special values:

  • A value of `lambda' enables Transient Mark mode temporarily. It is disabled again after any subsequent action that would normally deactivate the mark (e.g. buffer modification).

  • A value of (only . OLDVAL) enables Transient Mark mode temporarily. After any subsequent point motion command that is not shift-translated, or any other action that would normally deactivate the mark (e.g. buffer modification), the value of `transient-mark-mode' is set to OLDVAL.

    You can customize this variable.

(defvar transient-mark-mode nil)

A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it.

(defvar buffer-display-count nil)

*Position of this buffer's vertical scroll bar. The value takes effect whenever you tell a window to display this buffer; for instance, with set-window-buffer' or whendisplay-buffer' displays it.

A value of left' orright' means put the vertical scroll bar at that side of the window; a value of nil means don't show any vertical scroll bars. A value of t (the default) means do whatever the window's frame specifies.

(defvar vertical-scroll-bar true)

Default value of `indicate-empty-lines' for buffers that don't override it. This is the same as (default-value 'indicate-empty-lines).

(defvar default-indicate-empty-lines nil)

Non-nil means that Emacs should use caches to handle long lines more quickly.

Normally, the line-motion functions work by scanning the buffer for newlines. Columnar operations (like `move-to-column' and `compute-motion') also work by scanning the buffer, summing character widths as they go. This works well for ordinary text, but if the buffer's lines are very long (say, more than 500 characters), these motion functions will take longer to execute. Emacs may also take longer to update the display.

If `cache-long-line-scans' is non-nil, these motion functions cache the results of their scans, and consult the cache to avoid rescanning regions of the buffer until the text is modified. The caches are most beneficial when they prevent the most searching---that is, when the buffer contains long lines and large regions of characters with the same, fixed screen width.

When `cache-long-line-scans' is non-nil, processing short lines will become slightly slower (because of the overhead of consulting the cache), and the caches will use memory roughly proportional to the number of newlines and characters whose screen width varies.

The caches require no explicit maintenance; their accuracy is maintained internally by the Emacs primitives. Enabling or disabling the cache should not affect the behavior of any of the motion functions; it should only affect their performance.

(defvar cache-long-line-scans nil)

*Default value of `enable-multibyte-characters' for buffers not overriding it. This is the same as (default-value 'enable-multibyte-characters).

(defvar default-enable-multibyte-characters nil)

Default value of `fringes-outside-margins' for buffers that don't override it. This is the same as (default-value 'fringes-outside-margins).

(defvar default-fringes-outside-margins nil)

Pretty name of current buffer's major mode. Usually a string, but can use any of the constructs for `mode-line-format', which see. Format with `format-mode-line' to produce a string value.

(defvar mode-name "Fundamental")

List of undo entries in current buffer. Recent changes come first; older changes follow newer.

An entry (BEG . END) represents an insertion which begins at position BEG and ends at position END.

An entry (TEXT . POSITION) represents the deletion of the string TEXT from (abs POSITION). If POSITION is positive, point was at the front of the text being deleted; if negative, point was at the end.

An entry (t HIGH . LOW) indicates that the buffer previously had "unmodified" status. HIGH and LOW are the high and low 16-bit portions of the visited file's modification time, as of that time. If the modification time of the most recent save is different, this entry is obsolete.

An entry (nil PROPERTY VALUE BEG . END) indicates that a text property was modified between BEG and END. PROPERTY is the property name, and VALUE is the old value.

An entry (apply FUN-NAME . ARGS) means undo the change with (apply FUN-NAME ARGS).

An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo in the active region. BEG and END is the range affected by this entry and DELTA is the number of bytes added or deleted in that range by this change.

An entry (MARKER . DISTANCE) indicates that the marker MARKER was adjusted in position by the offset DISTANCE (an integer).

An entry of the form POSITION indicates that point was at the buffer location given by the integer. Undoing an entry of this form places point at POSITION.

Entries with value `nil' mark undo boundaries. The undo command treats the changes between two undo boundaries as a single step to be undone.

If the value of the variable is t, undo information is not recorded.

(defvar buffer-undo-list nil)

Abbreviated truename of file visited in current buffer, or nil if none. The truename of a file is calculated by `file-truename' and then abbreviated with `abbreviate-file-name'.

(defvar buffer-file-truename nil)

*Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame.

(defvar right-fringe-width nil)

Default value of `scroll-bar-width' for buffers that don't override it. This is the same as (default-value 'scroll-bar-width).

(defvar default-scroll-bar-width nil)

List of functions called with no args to query before killing a buffer. The buffer being killed will be current while the functions are running. If any of them returns nil, the buffer is not killed.

(defvar kill-buffer-query-functions nil)

Non-nil if self-insertion should replace existing text. The value should be one of `overwrite-mode-textual', `overwrite-mode-binary', or nil. If it is `overwrite-mode-textual', self-insertion still inserts at the end of a line, and inserts when point is before a tab, until the tab is filled in. If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.

(defvar overwrite-mode nil)

Default value of `right-fringe-width' for buffers that don't override it. This is the same as (default-value 'right-fringe-width).

(defvar default-right-fringe-width nil)

*Non-nil means to use word-wrapping for continuation lines. When word-wrapping is on, continuation lines are wrapped at the space or tab character nearest to the right window edge. If nil, continuation lines are wrapped at the right screen edge.

This variable has no effect if long lines are truncated (see truncate-lines' andtruncate-partial-width-windows'). If you use word-wrapping, you might want to reduce the value of `truncate-partial-width-windows', since wrapping can make text readable in narrower windows.

You can customize this variable.

(defvar word-wrap nil)

*Format in which to write auto-save files. Should be a list of symbols naming formats that are defined in `format-alist'. If it is t, which is the default, auto-save files are written in the same format as a regular save would use.

(defvar buffer-auto-save-file-format true)

*Value of `major-mode' for new buffers.

(defvar default-major-mode nil)

Default value of `left-margin' for buffers that do not override it. This is the same as (default-value 'left-margin).

(defvar default-left-margin nil)

Template for displaying mode line for current buffer. Each buffer has its own value of this variable. Value may be nil, a string, a symbol or a list or cons cell. A value of nil means don't display a mode line. For a symbol, its value is used (but it is ignored if t or nil). A string appearing directly as the value of a symbol is processed verbatim in that the %-constructs below are not recognized. Note that unless the symbol is marked as a `risky-local-variable', all properties in any strings, as well as all :eval and :propertize forms in the value of that symbol will be ignored. For a list of the form `(:eval FORM)', FORM is evaluated and the result is used as a mode line element. Be careful--FORM should not load any files, because that can cause an infinite recursion. For a list of the form `(:propertize ELT PROPS...)', ELT is displayed with the specified properties PROPS applied. For a list whose car is a symbol, the symbol's value is taken, and if that is non-nil, the cadr of the list is processed recursively. Otherwise, the caddr of the list (if there is one) is processed. For a list whose car is a string or list, each element is processed recursively and the results are effectively concatenated. For a list whose car is an integer, the cdr of the list is processed and padded (if the number is positive) or truncated (if negative) to the width specified by that number. A string is printed verbatim in the mode line except for %-constructs: (%-constructs are allowed when the string is the entire mode-line-format or when it is found in a cons-cell or a list) %b -- print buffer name. %f -- print visited file name. %F -- print frame name. %* -- print %, * or hyphen. %+ -- print *, % or hyphen. %& is like %*, but ignore read-only-ness. % means buffer is read-only and * means it is modified. For a modified read-only buffer, %* gives % and %+ gives *. %s -- print process status. %l -- print the current line number. %c -- print the current column number (this makes editing slower). To make the column number update correctly in all cases, `column-number-mode' must be non-nil. %i -- print the size of the buffer. %I -- like %i, but use k, M, G, etc., to abbreviate. %p -- print percent of buffer above top of window, or Top, Bot or All. %P -- print percent of buffer above bottom of window, perhaps plus Top, or print Bottom or All. %n -- print Narrow if appropriate. %t -- visited file is text or binary (if OS supports this distinction). %z -- print mnemonics of keyboard, terminal, and buffer coding systems. %Z -- like %z, but including the end-of-line format. %e -- print error message about full memory. %@ -- print @ or hyphen. @ means that default-directory is on a remote machine. %[ -- print one [ for each recursive editing level. %] similar. %% -- print %. %- -- print infinitely many dashes. Decimal digits after the % specify field width to which to pad.

You can customize this variable.

(defvar mode-line-format "%-")

Normal hook run before changing the major mode of a buffer. The function `kill-all-local-variables' runs this before doing anything else.

(defvar change-major-mode-hook nil)

How far to scroll windows downward. If you move point off the top, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, means scroll to center point. A fraction means scroll to put point that fraction of the window's height from the top of the window. When the value is 0.0, point goes at the top line, which in the simple case that you moved off with C-b means scrolling just one line. 1.0 means point goes at the bottom, so that in that simple case, the window scrolls by a full window height. Meaningful values are between 0.0 and 1.0, inclusive.

You can customize this variable.

(defvar scroll-down-aggressively nil)

*Mapping from logical to physical fringe cursor bitmaps. The value is an alist where each element (CURSOR . BITMAP) specifies the fringe bitmaps used to display a specific logical cursor type in the fringe.

CURSOR specifies the logical cursor type which is one of the following symbols: box' ,hollow', bar',hbar', or `hollow-small'. The last one is used to show a hollow cursor on narrow lines display lines where the normal hollow cursor will not fit.

BITMAP is the corresponding fringe bitmap shown for the logical cursor type.

(defvar fringe-cursor-alist nil)

Function called (if non-nil) to perform auto-fill. It is called after self-inserting any character specified in the `auto-fill-chars' table. NOTE: This variable is not a hook; its value may not be a list of functions.

(defvar auto-fill-function nil)

Value of point before the last series of scroll operations, or nil.

(defvar point-before-scroll nil)

*Width of right marginal area for display of a buffer. A value of nil means no marginal area.

(defvar right-margin-width 0)

Default value of `cursor-type' for buffers that don't override it. This is the same as (default-value 'cursor-type).

(defvar default-cursor-type nil)

*Width of this buffer's scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame.

(defvar scroll-bar-width nil)

Display table that controls display of the contents of current buffer.

If this variable is nil, the value of `standard-display-table' is used. Each window can have its own, overriding display table, see set-window-display-table' andwindow-display-table'.

The display table is a char-table created with `make-display-table'. A char-table is an array indexed by character codes. Normal array primitives aref' andaset' can be used to access elements of a char-table.

Each of the char-table elements control how to display the corresponding text character: the element at index C in the table says how to display the character whose code is C. Each element should be a vector of characters or nil. The value nil means display the character in the default fashion; otherwise, the characters from the vector are delivered to the screen instead of the original character.

For example, (aset buffer-display-table ?X [?Y]) tells Emacs to display a capital Y instead of each X character.

In addition, a char-table has six extra slots to control the display of:

the end of a truncated screen line (extra-slot 0, a single character);
the end of a continued line (extra-slot 1, a single character);
the escape character used to display character codes in octal
  (extra-slot 2, a single character);
the character used as an arrow for control characters (extra-slot 3,
  a single character);
the decoration indicating the presence of invisible lines (extra-slot 4,
  a vector of characters);
the character used to draw the border between side-by-side windows
  (extra-slot 5, a single character).

See also the functions display-table-slot' andset-display-table-slot'.

(defvar buffer-display-table nil)

*Visually indicate buffer boundaries and scrolling. If non-nil, the first and last line of the buffer are marked in the fringe of a window on window-systems with angle bitmaps, or if the window can be scrolled, the top and bottom line of the window are marked with up and down arrow bitmaps.

If value is a symbol left' orright', both angle and arrow bitmaps are displayed in the left or right fringe, resp. Any other value that doesn't look like an alist means display the angle bitmaps in the left fringe but no arrows.

You can exercise more precise control by using an alist as the value. Each alist element (INDICATOR . POSITION) specifies where to show one of the indicators. INDICATOR is one of `top', bottom',up', `down', or t, which specifies the default position, and POSITION is one of left',right', or nil, meaning do not show this indicator.

For example, ((top . left) (t . right)) places the top angle bitmap in left fringe, the bottom angle bitmap in right fringe, and both arrow bitmaps in right fringe. To show just the angle bitmaps in the left fringe, but no arrow bitmaps, use ((top . left) (bottom . left)).

You can customize this variable.

(defvar indicate-buffer-boundaries nil)

Default value of `left-margin-width' for buffers that don't override it. This is the same as (default-value 'left-margin-width).

(defvar default-left-margin-width nil)

Name of default directory of current buffer. Should end with slash. To interactively change the default directory, use command `cd'.

(defvar default-directory (some-> (System/getProperty "user.dir") (s/replace #"([^/])$" "$1/")))

Non-nil if this buffer is read-only.

(defvar buffer-read-only nil)

Symbol for current buffer's major mode. The default value (normally `fundamental-mode') affects new buffers. A value of nil means to use the current buffer's major mode, provided it is not marked as "special".

When a mode is used by default, `find-file' switches to it before it reads the contents into the buffer and before it finishes setting up the buffer. Thus, the mode and its hooks should not expect certain variables such as buffer-read-only' andbuffer-file-coding-system' to be set up.

You can customize this variable.

(defvar major-mode 'fundamental-mode)

*Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using C-x f.

You can customize this variable.

(defvar fill-column 70)

*Distance between tab stops (for display of tab characters), in columns. This should be an integer greater than zero.

You can customize this variable.

(defvar tab-width 8)

Default value of `cursor-in-non-selected-windows'. This is the same as (default-value 'cursor-in-non-selected-windows).

(defvar default-cursor-in-non-selected-windows nil)

Default value of `case-fold-search' for buffers that don't override it. This is the same as (default-value 'case-fold-search).

(defvar default-case-fold-search nil)

Length of current buffer when last read in, saved or auto-saved. 0 initially. -1 means auto-saving turned off until next real save.

If you set this to -2, that means don't turn off auto-saving in this buffer if its text size shrinks. If you use `buffer-swap-text' on a buffer, you probably should set this to -2 in that buffer.

(defvar buffer-saved-size 0)

*Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame.

(defvar left-fringe-width nil)

Coding system to be used for encoding the buffer contents on saving. This variable applies to saving the buffer, and also to `write-region' and other functions that use `write-region'. It does not apply to sending output to subprocesses, however.

If this is nil, the buffer is saved without any code conversion unless some coding system is specified in `file-coding-system-alist' for the buffer file.

If the text to be saved cannot be encoded as specified by this variable, an alternative encoding is selected by `select-safe-coding-system', which see.

The variable `coding-system-for-write', if non-nil, overrides this variable.

This variable is never applied to a way of decoding a file while reading it.

(defvar buffer-file-coding-system nil)

*Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode.

You can customize this variable.

(defvar left-margin 0)

Default value of `scroll-up-aggressively'. This value applies in buffers that don't have their own local values. This is the same as (default-value 'scroll-up-aggressively).

(defvar default-scroll-up-aggressively nil)

Default value of `abbrev-mode' for buffers that do not override it. This is the same as (default-value 'abbrev-mode).

(defvar default-abbrev-mode nil)

Non-nil if this buffer's file has been backed up. Backing up is done before the first time the file is saved.

(defvar buffer-backed-up nil)

List of functions to call after each text change. Three arguments are passed to each function: the positions of the beginning and end of the range of changed text, and the length in bytes of the pre-change text replaced by that range. (For an insertion, the pre-change length is zero; for a deletion, that length is the number of bytes deleted, and the post-change beginning and end are at the same place.)

Buffer changes made while executing the `after-change-functions' don't call any before-change or after-change functions. That's because `inhibit-modification-hooks' is temporarily set non-nil.

If an unhandled error happens in running these functions, the variable's value remains nil. That prevents the error from happening repeatedly and making Emacs nonfunctional.

(defvar after-change-functions nil)

Default value of `fringe-indicator-alist' for buffers that don't override it. This is the same as (default-value 'fringe-indicator-alist').

(defvar default-fringe-indicator-alist nil)

Default value of `header-line-format' for buffers that don't override it. This is the same as (default-value 'header-line-format).

(defvar default-header-line-format nil)

List of formats to use when saving this buffer. Formats are defined by `format-alist'. This variable is set when a file is visited.

(defvar buffer-file-format nil)

Analogous to `mode-line-format', but controls the header line. The header line appears, optionally, at the top of a window; the mode line appears at the bottom.

(defvar header-line-format nil)

Name of file for auto-saving current buffer. If it is nil, that means don't auto-save this buffer.

(defvar buffer-auto-save-file-name nil)

Default value of `truncate-lines' for buffers that do not override it. This is the same as (default-value 'truncate-lines).

(defvar default-truncate-lines nil)

Default value of `vertical-scroll-bar' for buffers that don't override it. This is the same as (default-value 'vertical-scroll-bar).

(defvar default-vertical-scroll-bar nil)

Hook run when the buffer list changes. Functions running this hook are `get-buffer-create', make-indirect-buffer',rename-buffer', `kill-buffer', and `bury-buffer-internal'.

(defvar buffer-list-update-hook nil)

*Non-nil means do not display continuation lines. Instead, give each line of text just one screen line.

Note that this is overridden by the variable `truncate-partial-width-windows' if that variable is non-nil and this buffer is not full-frame width.

Minibuffers set this variable to nil.

You can customize this variable.

(defvar truncate-lines nil)

Time stamp updated each time this buffer is displayed in a window. The function `set-window-buffer' updates this variable to the value obtained by calling `current-time'. If the buffer has never been shown in a window, the value is nil.

(defvar buffer-display-time nil)

*Visually indicate empty lines after the buffer end. If non-nil, a bitmap is displayed in the left fringe of a window on window-systems.

You can customize this variable.

(defvar indicate-empty-lines nil)

*Non-nil means display control chars with uparrow. A value of nil means use backslash and octal digits. This variable does not apply to characters whose display is specified in the current display table (if there is one).

You can customize this variable.

(defvar ctl-arrow true)

*Non-nil if searches and matches should ignore case.

You can customize this variable.

(defvar case-fold-search true)

Default value of `indicate-buffer-boundaries' for buffers that don't override it. This is the same as (default-value 'indicate-buffer-boundaries).

(defvar default-indicate-buffer-boundaries nil)

Additional space to put between lines when displaying a buffer. The space is measured in pixels, and put below lines on graphic displays, see `display-graphic-p'. If value is a floating point number, it specifies the spacing relative to the default frame line height. A value of nil means add no extra space.

You can customize this variable.

(defvar line-spacing nil)

Non-nil means the buffer contents are regarded as multi-byte characters. Otherwise they are regarded as unibyte. This affects the display, file I/O and the behavior of various editing commands.

This variable is buffer-local but you cannot set it directly; use the function `set-buffer-multibyte' to change a buffer's representation. See also Info node `(elisp)Text Representations'.

(defvar enable-multibyte-characters true)

*Width of left marginal area for display of a buffer. A value of nil means no marginal area.

(defvar left-margin-width 0)

A list of functions to call before changing a buffer which is unmodified. The functions are run using the `run-hooks' function.

(defvar first-change-hook nil)

*Non-nil means to display fringes outside display margins. A value of nil means to display fringes between margins and buffer text.

(defvar fringes-outside-margins nil)

Non-nil if Abbrev mode is enabled. Use the command `abbrev-mode' to change this variable.

(defvar abbrev-mode nil)

How far to scroll windows upward. If you move point off the bottom, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, means scroll to center point. A fraction means scroll to put point that fraction of the window's height from the bottom of the window. When the value is 0.0, point goes at the bottom line, which in the simple case that you moved off with C-f means scrolling just one line. 1.0 means point goes at the top, so that in that simple case, the window scrolls by a full window height. Meaningful values are between 0.0 and 1.0, inclusive.

You can customize this variable.

(defvar scroll-up-aggressively nil)

Default value of `fill-column' for buffers that do not override it. This is the same as (default-value 'fill-column).

(defvar default-fill-column nil)

*Mapping from logical to physical fringe indicator bitmaps. The value is an alist where each element (INDICATOR . BITMAPS) specifies the fringe bitmaps used to display a specific logical fringe indicator.

INDICATOR specifies the logical indicator type which is one of the following symbols: truncation' ,continuation', `overlay-arrow', top',bottom', top-bottom',up', down', empty-line', orunknown'.

BITMAPS is a list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies the actual bitmap shown in the left or right fringe for the logical indicator. LEFT and RIGHT are the bitmaps shown in the left and/or right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps are used only for the bottom' andtop-bottom' indicators when the last (only) line has no final newline. BITMAPS may also be a single symbol which is used in both left and right fringes.

(defvar fringe-indicator-alist nil)

Default value of `scroll-down-aggressively'. This value applies in buffers that don't have their own local values. This is the same as (default-value 'scroll-down-aggressively).

(defvar default-scroll-down-aggressively nil)

Default value of `tab-width' for buffers that do not override it. This is the same as (default-value 'tab-width).

(defvar default-tab-width nil)

Default value of `left-fringe-width' for buffers that don't override it. This is the same as (default-value 'left-fringe-width).

(defvar default-left-fringe-width nil)

Name of file visited in current buffer, or nil if not visiting a file.

(defvar buffer-file-name nil)

Default value of `buffer-file-coding-system' for buffers not overriding it. This is the same as (default-value 'buffer-file-coding-system).

(defvar default-buffer-file-coding-system nil)

*Non-nil means show a cursor in non-selected windows. If nil, only shows a cursor in the selected window. If t, displays a cursor related to the usual cursor type (a solid box becomes hollow, a bar becomes a narrower bar). You can also specify the cursor type as in the `cursor-type' variable. Use Custom to set this variable and update the display."

You can customize this variable.

(defvar cursor-in-non-selected-windows true)

Non-nil enables selective display. An integer N as value means display only lines that start with less than N columns of space. A value of t means that the character ^M makes itself and all the rest of the line invisible; also, when saving the buffer in a file, save the ^M as a newline.

(defvar selective-display nil)

Non-nil means display ... on previous line when a line is invisible.

You can customize this variable.

(defvar selective-display-ellipses true)

Cursor to use when this buffer is in the selected window. Values are interpreted as follows:

t         use the cursor specified for the frame
nil       don't display a cursor
box       display a filled box cursor
hollow    display a hollow box cursor
bar       display a vertical bar cursor with default width
(bar . WIDTH)     display a vertical bar cursor with width WIDTH
hbar          display a horizontal bar cursor with default height
(hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
ANYTHING ELSE     display a hollow box cursor

When the buffer is displayed in a non-selected window, the cursor's appearance is instead controlled by the variable `cursor-in-non-selected-windows'.

(defvar cursor-type true)

Non-nil means the mark and region are currently active in this buffer.

(defvar mark-active nil)

Default value of `fringe-cursor-alist' for buffers that don't override it. This is the same as (default-value 'fringe-cursor-alist').

(defvar default-fringe-cursor-alist nil)

*Non-nil means disregard read-only status of buffers or characters. If the value is t, disregard buffer-read-only' and allread-only' text properties. If the value is a list, disregard `buffer-read-only' and disregard a `read-only' text property if the property value is a member of the list.

(defvar inhibit-read-only nil)

Invisibility spec of this buffer. The default is t, which means that text is invisible if it has a non-nil `invisible' property. If the value is a list, a text character is invisible if its `invisible' property is an element in that list (or is a list with members in common). If an element is a cons cell of the form (PROP . ELLIPSIS), then characters with property value PROP are invisible, and they have an ellipsis as well if ELLIPSIS is non-nil.

(defvar buffer-invisibility-spec nil)

Non-nil means reorder bidirectional text for display in the visual order.

(defvar bidi-display-reordering true)

Default value of `right-margin-width' for buffers that don't override it. This is the same as (default-value 'right-margin-width).

(defvar default-right-margin-width nil)

Local (mode-specific) abbrev table of current buffer.

(defvar local-abbrev-table nil)

Default value of `mode-line-format' for buffers that don't override it. This is the same as (default-value 'mode-line-format).

(defvar default-mode-line-format nil)

*If non-nil, forces directionality of text paragraphs in the buffer.

If this is nil (the default), the direction of each paragraph is determined by the first strong directional character of its text. The values of right-to-left' andleft-to-right' override that. Any other value is treated as nil.

This variable has no effect unless the buffer's value of `bidi-display-reordering' is non-nil.

You can customize this variable.

(defvar bidi-paragraph-direction nil)
(def ^:private not-buffer-locals
  '#{kill-buffer-hook before-change-functions after-change-functions
     first-change-hook transient-mark-mode inhibit-read-only
     kill-buffer-query-functions change-major-mode-hook buffer-list-update-hook})
(defn ^:private read-buffer-locals []
  (with-open [r (PushbackReader. (io/reader (io/resource (str (s/replace (ns-name *ns*) "." "/") ".clj"))))]
    (group-by #(keyword (or (re-find #"default" (name %)) "local"))
              (remove not-buffer-locals
                      (map second
                           (filter (every-pred seq? (comp '#{defvar} first))
                                   (take-while (complement nil?)
                                               (repeatedly #(read r false nil)))))))))
(defn ^:private init-buffer-locals []
  (let [{:keys [default local]} (read-buffer-locals)]
    (reset! el/buffer-locals (set local))
    (doseq [d default
            :when (not= 'default-directory d)]
      (let [l (el/global (@el/buffer-locals (symbol (s/replace (name d) "default-" ))))]
        (.refer (the-ns 'deuce.emacs-lisp.globals) d l)))))
(init-buffer-locals)
(def ^:private buffer-alist (atom (ordered-map/ordered-map)))
(def ^:dynamic ^:private *current-buffer* nil)
(declare current-buffer set-buffer other-buffer buffer-name
         get-buffer buffer-local-value set-buffer-modified-p)

Signal a `buffer-read-only' error if the current buffer is read-only.

(defun barf-if-buffer-read-only ()
  (when (buffer-local-value 'buffer-read-only (current-buffer))
    (el/throw* 'buffer-read-only (buffer-name))))

Return t if OBJECT is an overlay.

(defun overlayp (object))

Create a new overlay with range BEG to END in BUFFER. If omitted, BUFFER defaults to the current buffer. BEG and END may be integers or markers. The fourth arg FRONT-ADVANCE, if non-nil, makes the marker for the front of the overlay advance when text is inserted there (which means the text is not included in the overlay). The fifth arg REAR-ADVANCE, if non-nil, makes the marker for the rear of the overlay advance when text is inserted there (which means the text is included in the overlay).

(defun make-overlay (beg end &optional buffer front-advance rear-advance)
  beg)

Return non-nil if OBJECT is a buffer which has not been killed. Value is nil if OBJECT is not a buffer or if it has been killed.

(defun buffer-live-p (object)
  (contains? (set (vals @buffer-alist)) object))

Like `set-buffer-modified-p', with a difference concerning redisplay. It is not ensured that mode lines will be updated to show the modified state of the current buffer. Use with care.

(defun restore-buffer-modified-p (flag)
  (set-buffer-modified-p flag))

Return t if BUFFER was modified since its file was last read or saved. No argument or nil as argument means use current buffer as BUFFER.

(defun buffer-modified-p (&optional buffer)
  (let [buffer ^Buffer (el/check-type 'bufferp (or buffer (current-buffer)))
        text ^BufferText (.text buffer)
        modiff @(.modiff text)]
    (and modiff (> modiff @(.save-modiff text)))))

Return BUFFER's character-change tick counter. Each buffer has a character-change tick counter, which is set to the value of the buffer's tick counter (see `buffer-modified-tick'), each time text in that buffer is inserted or deleted. By comparing the values returned by two individual calls of `buffer-chars-modified-tick', you can tell whether a character change occurred in that buffer in between these calls. No argument or nil as argument means use current buffer as BUFFER.

(defun buffer-chars-modified-tick (&optional buffer))

Return a string that is the name of no existing buffer based on NAME. If there is no live buffer named NAME, then return NAME. Otherwise modify name by appending `<NUMBER>', incrementing NUMBER (starting at 2) until an unused name is found, and then return that name. Optional second argument IGNORE specifies a name that is okay to use (if it is in the sequence to be tried) even if a buffer with that name exists.

(defun generate-new-buffer-name (name &optional ignore)
  (if-not (contains? @buffer-alist name)
    name
    (loop [idx 2]
      (let [name (str name  "<" idx ">")]
        (if (and (contains? @buffer-alist name) (not= ignore name))
          (recur (inc idx))
          name)))))

Set the multibyte flag of the current buffer to FLAG. If FLAG is t, this makes the buffer a multibyte buffer. If FLAG is nil, this makes the buffer a single-byte buffer. In these cases, the buffer contents remain unchanged as a sequence of bytes but the contents viewed as characters do change. If FLAG is `to', this makes the buffer a multibyte buffer by changing all eight-bit bytes to eight-bit characters. If the multibyte flag was really changed, undo information of the current buffer is cleared.

(defun set-buffer-multibyte (flag))

Recenter the overlays of the current buffer around position POS. That makes overlay lookup faster for positions near POS (but perhaps slower for positions far away from POS).

(defun overlay-recenter (pos))
(defn ^:private allocate-marker [insertion-type buffer charpos]
  (Marker. (atom  insertion-type) (atom buffer) (atom charpos)))

The eternal battle of how to represent mutable data like pt and name, nested atoms or updates via root buffer-alist? The latter doesn't work properly, save-current-buffer for example allows destructive updates to the current buffer it restores.

(defn ^:private allocate-buffer [name]
  (let [now (System/currentTimeMillis)
        text (BufferText. (StringBuilder.) (atom nil) (atom now) (atom nil))
        own-text text
        pt (atom 1)
        begv (atom nil)
        zv (atom nil)
        mark (atom (alloc/make-marker))
        buffer-locals (atom {})
        buffer (Buffer. own-text text pt begv zv (atom name) mark buffer-locals)]
    buffer))

Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed. If BUFFER-OR-NAME is a string and a live buffer with that name exists, return that buffer. If no such buffer exists, create a new buffer with that name and return it. If BUFFER-OR-NAME starts with a space, the new buffer does not keep undo information.

If BUFFER-OR-NAME is a buffer instead of a string, return it as given, even if it is dead. The return value is never nil.

(defun get-buffer-create (buffer-or-name)
  (if (data/bufferp buffer-or-name)
    buffer-or-name
    (or (get-buffer buffer-or-name)
        (let [buffer (allocate-buffer buffer-or-name)]
          (swap! buffer-alist assoc buffer-or-name buffer)
          buffer))))

Return the position at which OVERLAY starts.

(defun overlay-start (overlay))

Return the buffer named BUFFER-OR-NAME. BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME is a string and there is no buffer with that name, return nil. If BUFFER-OR-NAME is a buffer, return it as given.

(defun get-buffer (buffer-or-name)
  (if (data/bufferp buffer-or-name)
    buffer-or-name
    (and (el/check-type 'stringp buffer-or-name)
         (@buffer-alist buffer-or-name))))

Create and return an indirect buffer for buffer BASE-BUFFER, named NAME. BASE-BUFFER should be a live buffer, or the name of an existing buffer. NAME should be a string which is not the name of an existing buffer. Optional argument CLONE non-nil means preserve BASE-BUFFER's state, such as major and minor modes, in the indirect buffer. CLONE nil means the indirect buffer's state is reset to default values.

(defun make-indirect-buffer (base-buffer name &optional clone))

Return the current buffer as a Lisp object.

(defun current-buffer ()
  *current-buffer*)

Delete the overlay OVERLAY from its buffer.

(defun delete-overlay (overlay))

Return the base buffer of indirect buffer BUFFER. If BUFFER is not indirect, return nil. BUFFER defaults to the current buffer.

(defun buffer-base-buffer (&optional buffer))

Change current buffer's name to NEWNAME (a string). If second arg UNIQUE is nil or omitted, it is an error if a buffer named NEWNAME already exists. If UNIQUE is non-nil, come up with a new name using `generate-new-buffer-name'. Interactively, you can set UNIQUE with a prefix argument. We return the name we actually gave the buffer. This does not change the name of the visited file (if any).

(defun rename-buffer (newname &optional unique)
  (interactive "(list (read-string \"Rename buffer (to new name): \"  nil 'buffer-name-history (buffer-name (current-buffer))) current-prefix-arg)")
  (let [buffer-exists? (contains? @buffer-alist newname)]
    (if (= newname (buffer-name))
      newname
      (if (and unique buffer-exists?)
        (el/throw* 'error (format "Buffer name `%s' is in use" newname))
        (let [newname (if buffer-exists? (generate-new-buffer-name newname) newname)]
          (swap! buffer-alist dissoc (buffer-name))
          (swap! buffer-alist assoc newname (current-buffer))
          (reset! (.name ^Buffer (current-buffer)) newname))))))

Return the buffer OVERLAY belongs to. Return nil if OVERLAY has been deleted.

(defun overlay-buffer (overlay))

Delete the entire contents of the current buffer. Any narrowing restriction in effect (see `narrow-to-region') is removed, so the buffer is truly empty after this.

(defun erase-buffer ()
  (interactive "*")
  (let [text ^BufferText (.text ^Buffer (current-buffer))]
    ((el/fun 'widen))
    ((el/fun 'delete-region) 1 (inc (.length ^StringBuilder (.beg text))))
    nil))

Switch to Fundamental mode by killing current buffer's local variables. Most local variable bindings are eliminated so that the default values become effective once more. Also, the syntax table is set from `standard-syntax-table', the local keymap is set to nil, and the abbrev table from `fundamental-mode-abbrev-table'. This function also forces redisplay of the mode line.

Every function to select a new major mode starts by calling this function.

As a special exception, local variables whose names have a non-nil `permanent-local' property are not eliminated by this function.

The first thing this function does is run the normal hook `change-major-mode-hook'.

(defun kill-all-local-variables ()
  ;; (eval/run-hooks 'change-major-mode-hook)
  ;; (swap! (.local-var-alist ^Buffer (current-buffer)) empty))

Return the position at which OVERLAY ends.

(defun overlay-end (overlay))

Return the name of BUFFER, as a string. BUFFER defaults to the current buffer. Return nil if BUFFER has been killed.

(defun buffer-name (&optional buffer)
  @(.name ^Buffer (el/check-type 'bufferp (or buffer (current-buffer)))))

Set one property of overlay OVERLAY: give property PROP value VALUE. VALUE will be returned.

(defun overlay-put (overlay prop value))
(defn ^:private get-exisiting-buffer [buffer-or-name]
  (or (get-buffer buffer-or-name)
      (el/throw* 'error (format  "No buffer named %s" buffer-or-name))))

Make buffer BUFFER-OR-NAME current for editing operations. BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See also `save-excursion' when you want to make a buffer current temporarily. This function does not display the buffer, so its effect ends when the current command terminates. Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.

(defun set-buffer (buffer-or-name)
  ;; This is not correct, should only change the binding, but will do for now.
  (let [buffer (when buffer-or-name
                 (get-exisiting-buffer buffer-or-name))]
    (when buffer
      (swap! buffer-alist dissoc @(.name ^Buffer buffer))
      (swap! buffer-alist assoc @(.name ^Buffer buffer) buffer))
    (alter-var-root #'*current-buffer* (constantly buffer))))

Start keeping undo information for buffer BUFFER. No argument or nil as argument means do this for the current buffer.

(defun buffer-enable-undo (&optional buffer)
  (interactive))

Return a list of all existing live buffers. If the optional arg FRAME is a frame, we return the buffer list in the proper order for that frame: the buffers show in FRAME come first, followed by the rest of the buffers.

(defun buffer-list (&optional frame)
  (cons/maybe-seq (vals @buffer-alist)))

Move BUFFER to the end of the buffer list.

(defun bury-buffer-internal (buffer))

Return the previous position before POS where an overlay starts or ends. If there are no overlay boundaries from (point-min) to POS, the value is (point-min).

(defun previous-overlay-change (pos))

Return an alist of variables that are buffer-local in BUFFER. Most elements look like (SYMBOL . VALUE), describing one variable. For a symbol that is locally unbound, just the symbol appears in the value. Note that storing new VALUEs in these elements doesn't change the variables. No argument or nil as argument means use current buffer as BUFFER.

(defun buffer-local-variables (&optional buffer)
  (let [buffer ^Buffer (el/check-type 'bufferp (or buffer (current-buffer)))]
    (cons/maybe-seq (map #(alloc/cons (key %) (when-let [v (val %)] @v))
                         (merge (zipmap @el/buffer-locals (repeat nil))
                                @(.local-var-alist buffer))))))

Kill buffer BUFFER-OR-NAME. The argument may be a buffer or the name of an existing buffer. Argument nil or omitted means kill the current buffer. Return t if the buffer is actually killed, nil otherwise.

This function calls `replace-buffer-in-windows' for cleaning up all windows currently displaying the buffer to be killed. The functions in `kill-buffer-query-functions' are called with the buffer to be killed as the current buffer. If any of them returns nil, the buffer is not killed. The hook `kill-buffer-hook' is run before the buffer is actually killed. The buffer being killed will be current while the hook is running.

Any processes that have this buffer as the `process-buffer' are killed with SIGHUP.

(defun kill-buffer (&optional buffer-or-name)
  (interactive "bKill buffer: ")
  (let [buffer (if buffer-or-name
                 (get-exisiting-buffer buffer-or-name)
                 (current-buffer))]
    (if (or (not buffer)
            (and globals/kill-buffer-query-functions
                 (binding [*current-buffer* buffer]
                   (some nil? (map eval/funcall globals/kill-buffer-query-functions)))))
      false
      (do
        (binding [*current-buffer* buffer]
          (eval/run-hooks 'kill-buffer-hook))
        (swap! buffer-alist dissoc @(.name ^Buffer buffer))
        (set-buffer (other-buffer))
        true))))

Return a list of the overlays that overlap the region BEG ... END. Overlap means that at least one character is contained within the overlay and also contained within the specified region. Empty overlays are included in the result if they are located at BEG, between BEG and END, or at END provided END denotes the position at the end of the buffer.

(defun overlays-in (beg end))

Return the next position after POS where an overlay starts or ends. If there are no overlay boundaries from POS to (point-max), the value is (point-max).

(defun next-overlay-change (pos))

Swap the text between current buffer and BUFFER.

(defun buffer-swap-text (buffer))

Get the property of overlay OVERLAY with property name PROP.

(defun overlay-get (overlay prop))

Return a pair of lists giving all the overlays of the current buffer. The car has all the overlays before the overlay center; the cdr has all the overlays after the overlay center. Recentering overlays moves overlays between these lists. The lists you get are copies, so that changing them has no effect. However, the overlays you get are the real objects that the buffer uses.

(defun overlay-lists ())

Mark current buffer as modified or unmodified according to FLAG. A non-nil FLAG means mark the buffer modified.

(defun set-buffer-modified-p (flag)
  (reset! (.modiff ^BufferText (.text ^Buffer (current-buffer))) (when flag (System/currentTimeMillis))))

Set the endpoints of OVERLAY to BEG and END in BUFFER. If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now. If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current buffer.

(defun move-overlay (overlay beg end &optional buffer))

Return BUFFER's tick counter, incremented for each change in text. Each buffer has a tick counter which is incremented each time the text in that buffer is changed. It wraps around occasionally. No argument or nil as argument means use current buffer as BUFFER.

(defun buffer-modified-tick (&optional buffer))

Return name of file BUFFER is visiting, or nil if none. No argument or nil as argument means use the current buffer.

(defun buffer-file-name (&optional buffer)
  (buffer-local-value 'buffer-file-name (or buffer (current-buffer))))

Return the value of VARIABLE in BUFFER. If VARIABLE does not have a buffer-local binding in BUFFER, the value is the default binding of the variable.

(defun buffer-local-value (variable buffer)
  (binding [*current-buffer* buffer]
    (data/symbol-value variable)))

Return the buffer visiting file FILENAME (a string). The buffer's `buffer-file-name' must match exactly the expansion of FILENAME. If there is no such live buffer, return nil. See also `find-buffer-visiting'.

(defun get-file-buffer (filename)
  (first (filter (comp #{((el/fun 'expand-file-name) filename)} buffer-file-name) (vals @buffer-alist))))

Return a list of the properties on OVERLAY. This is a copy of OVERLAY's plist; modifying its conses has no effect on OVERLAY.

(defun overlay-properties (overlay))

Return most recently selected buffer other than BUFFER. Buffers not visible in windows are preferred to visible buffers, unless optional second argument VISIBLE-OK is non-nil. Ignore the argument BUFFER unless it denotes a live buffer. If the optional third argument FRAME is non-nil, use that frame's buffer list instead of the selected frame's buffer list.

The buffer is found by scanning the selected or specified frame's buffer list first, followed by the list of all buffers. If no other buffer exists, return the buffer `scratch' (creating it if necessary).

(defun other-buffer (&optional buffer visible-ok frame)
  (or (last (remove #{(el/check-type 'bufferp (or buffer (current-buffer)))}
                    (vals @buffer-alist)))
      (get-buffer-create "*scratch*")))

Return a list of the overlays that contain the character at POS.

(defun overlays-at (pos))

Set an appropriate major mode for BUFFER. For the scratch buffer, use `initial-major-mode', otherwise choose a mode according to `default-major-mode'. Use this function before selecting the buffer, since it may need to inspect the current buffer's major mode.

(defun set-buffer-major-mode (buffer)
  (when-let [mode (if (= "*scratch*" (buffer-name buffer))
                    (data/symbol-value 'initial-major-mode)
                    (or (data/default-value 'major-mode)
                        (data/symbol-value 'major-mode)))]
    (binding [*current-buffer* buffer]
      (eval/funcall mode))))
 
(ns deuce.emacs.chartab
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.data :as data]
            [deuce.emacs.fns :as fns])
  (:import [deuce.emacs.data CharTable]
           [java.util Arrays])
  (:refer-clojure :exclude []))

Alist of character property name vs char-table containing property values. Internal use only.

(defvar char-code-property-alist nil)

Return the parent char-table of CHAR-TABLE. The value is either nil or another char-table. If CHAR-TABLE holds nil for a given character, then the actual applicable value is inherited from the parent char-table (or from its parents, if necessary).

(defun char-table-parent (char-table)
  @(.parent ^CharTable char-table))

Set the parent char-table of CHAR-TABLE to PARENT. Return PARENT. PARENT must be either nil or another char-table.

(defun set-char-table-parent (char-table parent)
  (reset! (.parent ^CharTable char-table) parent))

Call FUNCTION for each character in CHAR-TABLE that has non-nil value. FUNCTION is called with two arguments--a key and a value. The key is a character code or a cons of character codes specifying a range of characters that have the same value.

(defun map-char-table (function char-table))

Return the value of CHAR-TABLE's extra-slot number N.

(defun char-table-extra-slot (char-table n)
  (aget ^objects (.extras ^CharTable char-table) n))

Return the subtype of char-table CHAR-TABLE. The value is a symbol.

(defun char-table-subtype (char-table)
  (.purpose ^CharTable char-table))

Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. RANGE should be t (for all characters), nil (for the default value), a cons of character codes (for characters in the range), or a character code. Return VALUE.

(defun set-char-table-range (char-table range value)
  (let [[start end] (if (data/consp range)
                      [(int (data/car range)) (int (data/cdr range))]
                      [0 (count (.contents ^CharTable  char-table))])]
    (Arrays/fill ^objects (.contents ^CharTable char-table) (int start) (int end)
                 (if (nil? range) (.defalt ^CharTable char-table) value)))
  value)

Return an element of CHAR-TABLE for character CH. CHAR-TABLE must be what returned by `unicode-property-table-internal'.

(defun get-unicode-property-internal (char-table ch))

Set CHAR-TABLE's extra-slot number N to VALUE.

(defun set-char-table-extra-slot (char-table n value)
  (aset ^objects (.extras ^CharTable char-table) n value))

Return a char-table for Unicode character property PROP. Use `get-unicode-property-internal' and put-unicode-property-internal' instead ofaref' and `aset' to get and put an element value.

(defun unicode-property-table-internal (prop))
(def ^:private char-table-size 4194303)

Return a newly created char-table, with purpose PURPOSE. Each element is initialized to INIT, which defaults to nil.

PURPOSE should be a symbol. If it has a `char-table-extra-slots' property, the property's value should be an integer between 0 and 10 that specifies how many extra slots the char-table has. Otherwise, the char-table has no extra slot.

(defun make-char-table (purpose &optional init)
  (CharTable. init (atom nil) purpose
              (alloc/make-vector char-table-size init)
              (when-let [extras (fns/get purpose 'char-table-extra-slots)]
                (alloc/make-vector extras init))))

This function is obsolete since 23.1; generic characters no longer exist.

This function is obsolete and has no effect.

(defun set-char-table-default (char-table ch value)
  nil)

Return the value in CHAR-TABLE for a range of characters RANGE. RANGE should be nil (for the default value), a cons of character codes (for characters in the range), or a character code.

(defun char-table-range (char-table range))

Optimize CHAR-TABLE. TEST is the comparison function used to decide whether two entries are equivalent and can be merged. It defaults to `equal'.

(defun optimize-char-table (char-table &optional test)
  nil)

Set an element of CHAR-TABLE for character CH to VALUE. CHAR-TABLE must be what returned by `unicode-property-table-internal'.

(defun put-unicode-property-internal (char-table ch value))
 
(ns deuce.emacs.filelock
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.fileio :as fileio])
  (:refer-clojure :exclude []))

The directory for writing temporary files.

You can customize this variable.

(defvar temporary-file-directory (fileio/file-name-as-directory (System/getProperty "java.io.tmpdir")))

Lock FILE, if current buffer is modified. FILE defaults to current buffer's visited file, or else nothing is done if current buffer isn't visiting a file.

(defun lock-buffer (&optional file))

Unlock the file visited in the current buffer. If the buffer is not modified, this does nothing because the file should not be locked in that case.

(defun unlock-buffer ())

Return a value indicating whether FILENAME is locked. The value is nil if the FILENAME is not locked, t if it is locked by you, else a string saying which user has locked it.

(defun file-locked-p (filename))
 
(ns deuce.emacs.casetab
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.chartab :as chartab]
            [deuce.emacs.data :as data]
            [deuce.emacs.fns :as fns])
  (:import [deuce.emacs.data CharTable])
  (:refer-clojure "exclude" []))
(fns/put 'case-table 'char-table-extra-slots 3)
(def ^:private ascii-downcase-table (atom (chartab/make-char-table 'case-table)))

Select a new standard case table for new buffers. See `set-case-table' for more info on case tables.

(defun set-standard-case-table (table)
  (reset! ascii-downcase-table table))

Return t if OBJECT is a case table. See `set-case-table' for more information on these data structures.

(defun case-table-p (object)
  (and (data/char-table-p object) (= 'case-table (.purpose ^CharTable object))))

Return the case table of the current buffer.

(defun current-case-table ())

Select a new case table for the current buffer. A case table is a char-table which maps characters to their lower-case equivalents. It also has three "extra" slots which may be additional char-tables or nil. These slots are called UPCASE, CANONICALIZE and EQUIVALENCES. UPCASE maps each non-upper-case character to its upper-case equivalent. (The value in UPCASE for an upper-case character is never used.) If lower and upper case characters are in 1-1 correspondence, you may use nil and the upcase table will be deduced from DOWNCASE. CANONICALIZE maps each character to a canonical equivalent; any two characters that are related by case-conversion have the same canonical equivalent character; it may be nil, in which case it is deduced from DOWNCASE and UPCASE. EQUIVALENCES is a map that cyclically permutes each equivalence class (of characters with the same canonical equivalent); it may be nil, in which case it is deduced from CANONICALIZE.

(defun set-case-table (table))

Return the standard case table. This is the one used for new buffers.

(defun standard-case-table ()
  @ascii-downcase-table)
 
(ns deuce.emacs.coding
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.charset :as charset]
            [deuce.emacs.fns :as fns]
            [deuce.emacs-lisp.globals :as globals])
  (:refer-clojure :exclude []))

If non-nil, Emacs ignores null bytes on code detection. By default, Emacs treats it as binary data, and does not attempt to decode it. The effect is as if you specified `no-conversion' for reading that text.

Set this to non-nil when a regular text happens to include null bytes. Examples are Index nodes of Info files and null-byte delimited output from GNU Find and GNU Grep. Emacs will then ignore the null bytes and decode text as usual.

(defvar inhibit-null-byte-detection nil)

*String displayed in mode line when end-of-line format is not yet determined.

You can customize this variable.

(defvar eol-mnemonic-undecided ":")

Table of extra Latin codes in the range 128..159 (inclusive). This is a vector of length 256. If Nth element is non-nil, the existence of code N in a file (or output of subprocess) doesn't prevent it to be detected as a coding system of ISO 2022 variant which has a flag `accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file or reading output of a subprocess. Only 128th through 159th elements have a meaning.

(defvar latin-extra-code-table nil)

Coding system used in the latest file or process I/O.

(defvar last-coding-system-used nil)

Alist of charsets vs revision numbers. While encoding, if a charset (car part of an element) is found, designate it with the escape sequence identifying revision (cdr part of the element).

(defvar charset-revision-table nil)

Table for translating characters while decoding.

(defvar standard-translation-table-for-decode nil)

If non-nil, Emacs ignores ISO-2022 escape sequences during code detection.

When Emacs reads text, it tries to detect how the text is encoded. This code detection is sensitive to escape sequences. If Emacs sees a valid ISO-2022 escape sequence, it assumes the text is encoded in one of the ISO2022 encodings, and decodes text by the corresponding coding system (e.g. `iso-2022-7bit').

However, there may be a case that you want to read escape sequences in a file as is. In such a case, you can set this variable to non-nil. Then the code detection will ignore any escape sequences, and no text is detected as encoded in some ISO-2022 encoding. The result is that all escape sequences become visible in a buffer.

The default value is nil, and it is strongly recommended not to change it. That is because many Emacs Lisp source files that contain non-ASCII characters are encoded by the coding system `iso-2022-7bit' in Emacs's distribution, and they won't be decoded correctly on reading if you suppress escape sequence detection.

The other way to read escape sequences in a file without decoding is to explicitly specify some coding system that doesn't use ISO-2022 escape sequence (e.g `latin-1') on reading by C-x RET c.

(defvar inhibit-iso-escape-detection nil)

List of coding systems.

Do not alter the value of this variable manually. This variable should be updated by the functions `define-coding-system' and `define-coding-system-alias'.

(defvar coding-system-list nil)

Table for translating characters while encoding.

(defvar standard-translation-table-for-encode nil)

Specify the coding system for write operations. Programs bind this variable with `let', but you should not set it globally. If the value is a coding system, it is used for encoding of output, when writing it to a file and when sending it to a file or subprocess.

If this does not specify a coding system, an appropriate element is used from one of the coding system alists. There are three such tables: `file-coding-system-alist', process-coding-system-alist', andnetwork-coding-system-alist'. For output to files, if the above procedure does not specify a coding system, the value of `buffer-file-coding-system' is used.

(defvar coding-system-for-write nil)

*Non-nil enables character translation while encoding and decoding.

(defvar enable-character-translation nil)

*String displayed in mode line for UNIX-like (LF) end-of-line format.

You can customize this variable.

(defvar eol-mnemonic-unix ":")

Specify the coding system for read operations. It is useful to bind this variable with `let', but do not set it globally. If the value is a coding system, it is used for decoding on read operation. If not, an appropriate element is used from one of the coding system alists. There are three such tables: `file-coding-system-alist', process-coding-system-alist', andnetwork-coding-system-alist'.

(defvar coding-system-for-read nil)

*String displayed in mode line for MAC-like (CR) end-of-line format.

You can customize this variable.

(defvar eol-mnemonic-mac "/")

Non-nil means process buffer inherits coding system of process output. Bind it to t if the process output is to be treated as if it were a file read from some filesystem.

(defvar inherit-process-coding-system nil)

Function to call to select safe coding system for encoding a text.

If set, this function is called to force a user to select a proper coding system which can encode the text in the case that a default coding system used in each operation can't encode the text. The function should take care that the buffer is not modified while the coding system is being selected.

The default value is `select-safe-coding-system' (which see).

(defvar select-safe-coding-system-function nil)

*String displayed in mode line for DOS-like (CRLF) end-of-line format.

You can customize this variable.

(defvar eol-mnemonic-dos "\\")

Error status of the last code conversion.

When an error was detected in the last code conversion, this variable is set to one of the following symbols. `insufficient-source' `inconsistent-eol' `invalid-source' `interrupted' `insufficient-memory' When no error was detected, the value doesn't change. So, to check the error status of a code conversion by this variable, you must explicitly set this variable to nil before performing code conversion.

(defvar last-code-conversion-error nil)

Alist to decide a coding system to use for a file I/O operation. The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression matching a file name, VAL is a coding system, a cons of coding systems, or a function symbol. If VAL is a coding system, it is used for both decoding and encoding the file contents. If VAL is a cons of coding systems, the car part is used for decoding, and the cdr part is used for encoding. If VAL is a function symbol, the function must return a coding system or a cons of coding systems which are used as above. The function is called with an argument that is a list of the arguments with which `find-operation-coding-system' was called. If the function can't decide a coding system, it can return `undecided' so that the normal code-detection is performed.

See also the function `find-operation-coding-system' and the variable `auto-coding-alist'.

You can customize this variable.

(defvar file-coding-system-alist nil)

Alist to decide a coding system to use for a network I/O operation. The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression matching a network service name or is a port number to connect to, VAL is a coding system, a cons of coding systems, or a function symbol. If VAL is a coding system, it is used for both decoding what received from the network stream and encoding what sent to the network stream. If VAL is a cons of coding systems, the car part is used for decoding, and the cdr part is used for encoding. If VAL is a function symbol, the function must return a coding system or a cons of coding systems which are used as above.

See also the function `find-operation-coding-system'.

(defvar network-coding-system-alist nil)

Cons of coding systems used for process I/O by default. The car part is used for decoding a process output, the cdr part is used for encoding a text to be sent to a process.

(defvar default-process-coding-system nil)

*Non-nil means always inhibit code conversion of end-of-line format. See info node Coding Systems' and info nodeText and Binary' concerning such conversion.

You can customize this variable.

(defvar inhibit-eol-conversion nil)

Alist of coding system names. Each element is one element list of coding system name. This variable is given to `completing-read' as COLLECTION argument.

Do not alter the value of this variable manually. This variable should be updated by the functions `make-coding-system' and `define-coding-system-alias'.

(defvar coding-system-alist nil)

Internal use only. If non-nil, on writing a file, `select-safe-coding-system-function' is called even if `coding-system-for-write' is non-nil. The command `universal-coding-system-argument' binds this variable to t temporarily.

(defvar coding-system-require-warning nil)

Coding system to use with system messages. Also used for decoding keyboard input on X Window system.

(defvar locale-coding-system nil)

Char table for translating self-inserting characters. This is applied to the result of input methods, not their input. See also `keyboard-translate-table'.

Use of this variable for character code unification was rendered obsolete in Emacs 23.1 and later, since Unicode is now the basis of internal character representation.

(defvar translation-table-for-input nil)

List of coding-categories (symbols) ordered by priority.

On detecting a coding system, Emacs tries code detection algorithms associated with each coding-category one by one in this order. When one algorithm agrees with a byte sequence of source text, the coding system bound to the corresponding coding-category is selected.

Don't modify this variable directly, but use `set-coding-system-priority'.

(defvar coding-category-list nil)

Alist to decide a coding system to use for a process I/O operation. The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression matching a program name, VAL is a coding system, a cons of coding systems, or a function symbol. If VAL is a coding system, it is used for both decoding what received from the program and encoding what sent to the program. If VAL is a cons of coding systems, the car part is used for decoding, and the cdr part is used for encoding. If VAL is a function symbol, the function must return a coding system or a cons of coding systems which are used as above.

See also the function `find-operation-coding-system'.

(defvar process-coding-system-alist nil)
(declare check-coding-system)
(fns/put 'translation-table 'char-table-extra-slots 2)

Return the base of CODING-SYSTEM. Any alias or subsidiary coding system is not a base coding system.

(defun coding-system-base (coding-system))

Encode the Big5 character CH to BIG5 coding system. Return the corresponding character code in Big5.

(defun encode-big5-char (ch))

Return eol-type of CODING-SYSTEM. An eol-type is an integer 0, 1, 2, or a vector of coding systems.

Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF, and CR respectively.

A vector value indicates that a format of end-of-line should be detected automatically. Nth element of the vector is the subsidiary coding system whose eol-type is N.

(defun coding-system-eol-type (coding-system)
  ({"\n" '0 "\r\n" 1 "\r" 2} (System/lineSeparator)))

Return the list of aliases of CODING-SYSTEM.

(defun coding-system-aliases (coding-system))

Internal use only.

(defun set-safe-terminal-coding-system-internal (coding-system))

Define ALIAS as an alias for CODING-SYSTEM.

(defun define-coding-system-alias (alias coding-system))

Decode a Big5 character which has CODE in BIG5 coding system. Return the corresponding character.

(defun decode-big5-char (code))

Internal use only.

(defun set-keyboard-coding-system-internal (coding-system &optional terminal))

Return the property list of CODING-SYSTEM.

(defun coding-system-plist (coding-system))

Internal use only.

(defun find-coding-systems-region-internal (start end &optional exclude))

Decode the current region from the specified coding system. When called from a program, takes four arguments: START, END, CODING-SYSTEM, and DESTINATION. START and END are buffer positions.

Optional 4th arguments DESTINATION specifies where the decoded text goes. If nil, the region between START and END is replaced by the decoded text. If buffer, the decoded text is inserted in that buffer after point (point does not move). In those cases, the length of the decoded text is returned. If DESTINATION is t, the decoded text is returned.

This function sets `last-coding-system-used' to the precise coding system used (which may be different from CODING-SYSTEM if CODING-SYSTEM is not fully specified.)

(defun decode-coding-region (start end coding-system &optional destination)
  (interactive "r\nzCoding system: "))

Detect coding system of the text in STRING. Return a list of possible coding systems ordered by priority. The coding systems to try and their priorities follows what the function `coding-system-priority-list' (which see) returns.

If only ASCII characters are found (except for such ISO-2022 control characters as ESC), it returns a list of single element `undecided' or its subsidiary coding system according to a detected end-of-line format.

If optional argument HIGHEST is non-nil, return the coding system of highest priority.

(defun detect-coding-string (string &optional highest))

Encode the current region by specified coding system. When called from a program, takes four arguments: START, END, CODING-SYSTEM and DESTINATION. START and END are buffer positions.

Optional 4th arguments DESTINATION specifies where the encoded text goes. If nil, the region between START and END is replace by the encoded text. If buffer, the encoded text is inserted in that buffer after point (point does not move). In those cases, the length of the encoded text is returned. If DESTINATION is t, the encoded text is returned.

This function sets `last-coding-system-used' to the precise coding system used (which may be different from CODING-SYSTEM if CODING-SYSTEM is not fully specified.)

(defun encode-coding-region (start end coding-system &optional destination)
  (interactive "r\nzCoding system: "))

Decode a Japanese character which has CODE in shift_jis encoding. Return the corresponding character.

(defun decode-sjis-char (code))

Return position of first un-encodable character in a region. START and END specify the region and CODING-SYSTEM specifies the encoding to check. Return nil if CODING-SYSTEM does encode the region.

If optional 4th argument COUNT is non-nil, it specifies at most how many un-encodable characters to search. In this case, the value is a list of positions.

If optional 5th argument STRING is non-nil, it is a string to search for un-encodable characters. In that case, START and END are indexes to the string.

(defun unencodable-char-position (start end coding-system &optional count string))

Read a coding system from the minibuffer, prompting with string PROMPT. If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. Ignores case when completing coding systems (all Emacs coding systems are lower-case).

(defun read-coding-system (prompt &optional default-coding-system))

Check if the region is encodable by coding systems.

START and END are buffer positions specifying the region. CODING-SYSTEM-LIST is a list of coding systems to check.

The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where CODING-SYSTEM is a member of CODING-SYSTEM-LIST and can't encode the whole region, POS0, POS1, ... are buffer positions where non-encodable characters are found.

If all coding systems in CODING-SYSTEM-LIST can encode the region, the value is nil.

START may be a string. In that case, check if the string is encodable, and the value contains indices to the string instead of buffer positions. END is ignored.

If the current buffer (or START if it is a string) is unibyte, the value is nil.

(defun check-coding-systems-region (start end coding-system-list))

Encode STRING to CODING-SYSTEM, and return the result.

Optional third arg NOCOPY non-nil means it is OK to return STRING itself if the encoding operation is trivial.

Optional fourth arg BUFFER non-nil means that the encoded text is inserted in that buffer after point (point does not move). In this case, the return value is the length of the encoded text.

This function sets `last-coding-system-used' to the precise coding system used (which may be different from CODING-SYSTEM if CODING-SYSTEM is not fully specified.)

(defun encode-coding-string (string coding-system &optional nocopy buffer)
  (check-coding-system coding-system)
  (el/setq last-coding-system-used coding-system)
  string)

Choose a coding system for an operation based on the target name. The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM). DECODING-SYSTEM is the coding system to use for decoding (in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system for encoding (in case OPERATION does encoding).

The first argument OPERATION specifies an I/O primitive: For file I/O, insert-file-contents' orwrite-region'. For process I/O, call-process',call-process-region', or `start-process'. For network I/O, `open-network-stream'.

The remaining arguments should be the same arguments that were passed to the primitive. Depending on which primitive, one of those arguments is selected as the TARGET. For example, if OPERATION does file I/O, whichever argument specifies the file name is TARGET.

TARGET has a meaning which depends on OPERATION: For file I/O, TARGET is a file name (except for the special case below). For process I/O, TARGET is a process name. For network I/O, TARGET is a service name or a port number.

This function looks up what is specified for TARGET in file-coding-system-alist',process-coding-system-alist', or `network-coding-system-alist' depending on OPERATION. They may specify a coding system, a cons of coding systems, or a function symbol to call. In the last case, we call the function with one argument, which is a list of all the arguments given to this function. If the function can't decide a coding system, it can return `undecided' so that the normal code-detection is performed.

If OPERATION is `insert-file-contents', the argument corresponding to TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a file name to look up, and BUFFER is a buffer that contains the file's contents (not yet decoded). If `file-coding-system-alist' specifies a function to call for FILENAME, that function should examine the contents of BUFFER instead of reading the file.

(defun find-operation-coding-system (operation &rest arguments))

Return coding system specified for terminal output on the given terminal. TERMINAL may be a terminal object, a frame, or nil for the selected frame's terminal device.

(defun terminal-coding-system (&optional terminal))

Return a list of coding systems ordered by their priorities. The list contains a subset of coding systems; i.e. coding systems assigned to each coding category (see `coding-category-list').

HIGHESTP non-nil means just return the highest priority one.

(defun coding-system-priority-list (&optional highestp))

Return coding system specified for decoding keyboard input.

(defun keyboard-coding-system (&optional terminal)
  'iso-latin-1-unix)

Detect coding system of the text in the region between START and END. Return a list of possible coding systems ordered by priority. The coding systems to try and their priorities follows what the function `coding-system-priority-list' (which see) returns.

If only ASCII characters are found (except for such ISO-2022 control characters as ESC), it returns a list of single element `undecided' or its subsidiary coding system according to a detected end-of-line format.

If optional argument HIGHEST is non-nil, return the coding system of highest priority.

(defun detect-coding-region (start end &optional highest))

For internal use only.

(defun define-coding-system-internal (&rest args))

Change value in CODING-SYSTEM's property list PROP to VAL.

(defun coding-system-put (coding-system prop val))

Decode STRING which is encoded in CODING-SYSTEM, and return the result.

Optional third arg NOCOPY non-nil means it is OK to return STRING itself if the decoding operation is trivial.

Optional fourth arg BUFFER non-nil means that the decoded text is inserted in that buffer after point (point does not move). In this case, the return value is the length of the decoded text.

This function sets `last-coding-system-used' to the precise coding system used (which may be different from CODING-SYSTEM if CODING-SYSTEM is not fully specified.)

(defun decode-coding-string (string coding-system &optional nocopy buffer)
  (check-coding-system coding-system)
  (el/setq last-coding-system-used coding-system)
  string)

Internal use only.

(defun set-terminal-coding-system-internal (coding-system &optional terminal))

Read a coding system from the minibuffer, prompting with string PROMPT.

(defun read-non-nil-coding-system (prompt))

Encode a Japanese character CH to shift_jis encoding. Return the corresponding code in SJIS.

(defun encode-sjis-char (ch))

Assign higher priority to the coding systems given as arguments. If multiple coding systems belong to the same category, all but the first one are ignored.

(defun set-coding-system-priority (&rest coding-systems))

Check validity of CODING-SYSTEM. If valid, return CODING-SYSTEM, else signal a `coding-system-error' error. It is valid if it is nil or a symbol defined as a coding system by the function `define-coding-system'.

(defun check-coding-system (coding-system)
  (if (nil? coding-system)
    coding-system
    (el/throw 'coding-system-error coding-system)))

Return t if OBJECT is nil or a coding-system. See the documentation of `define-coding-system' for information about coding-system objects.

(defun coding-system-p (object))
 
(ns deuce.emacs.marker
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data])
  (:import [deuce.emacs.data Buffer BufferText Marker])
  (:refer-clojure :exclude []))

Non-nil enables debugging checks in byte/char position conversions.

(defvar byte-debug-flag nil)

Return the position MARKER points at, as a character number. Returns nil if MARKER points nowhere.

(defun marker-position (marker)
  @(.charpos ^Marker marker))

Return t if there are markers pointing at POSITION in the current buffer.

(defun buffer-has-markers-at (position))

Return a new marker pointing at the same place as MARKER. If argument is a number, makes a new marker pointing at that position in the current buffer. If MARKER is not specified, the new marker does not point anywhere. The optional argument TYPE specifies the insertion type of the new marker; see `marker-insertion-type'.

(defun copy-marker (&optional marker type)
  ((ns-resolve 'deuce.emacs.buffer 'allocate-marker) type
   (buffer/current-buffer) (if (data/markerp marker)
                             @(.charpos ^Marker marker)
                             (el/check-type 'integerp marker))))

Return insertion type of MARKER: t if it stays after inserted text. The value nil means the marker stays before text inserted there.

(defun marker-insertion-type (marker)
  @(.insertion-type ^Marker marker))

Set the insertion-type of MARKER to TYPE. If TYPE is t, it means the marker advances when you insert text at it. If TYPE is nil, it means the marker stays behind when you insert text at it.

(defun set-marker-insertion-type (marker type)
  (reset! (.insertion-type ^Marker marker) type))

Return the buffer that MARKER points into, or nil if none. Returns nil if MARKER points into a dead buffer.

(defun marker-buffer (marker)
  @(.buffer ^Marker marker))

Position MARKER before character number POSITION in BUFFER. BUFFER defaults to the current buffer. If POSITION is nil, makes marker point nowhere. Then it no longer slows down editing in any buffer. Returns MARKER.

(defun set-marker (marker position &optional buffer)
  (let [^Buffer buffer (el/check-type 'bufferp (or buffer (buffer/current-buffer)))
        ^Marker marker marker]
    (when-let [^Buffer old-buffer @(.buffer marker)]
      (swap! (.markers ^BufferText (.text old-buffer)) #(seq (remove #{marker} %))))
    (reset! (.buffer marker) buffer)
    (reset! (.charpos marker) position)
    (swap! (.markers ^BufferText (.text buffer)) conj marker)
    marker))
 
(ns deuce.emacs.category
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.fns :as fns])
  (:refer-clojure :exclude []))

List of pair (cons) of categories to determine word boundary. See the documentation of the variable `word-combining-categories'.

(defvar word-separating-categories nil)

List of pair (cons) of categories to determine word boundary.

Emacs treats a sequence of word constituent characters as a single word (i.e. finds no word boundary between them) only if they belong to the same script. But, exceptions are allowed in the following cases.

(1) The case that characters are in different scripts is controlled by the variable `word-combining-categories'.

Emacs finds no word boundary between characters of different scripts if they have categories matching some element of this list.

More precisely, if an element of this list is a cons of category CAT1 and CAT2, and a multibyte character C1 which has CAT1 is followed by C2 which has CAT2, there's no word boundary between C1 and C2.

For instance, to tell that Han characters followed by Hiragana characters can form a single word, the element `(?C . ?H)' should be in this list.

(2) The case that character are in the same script is controlled by the variable `word-separating-categories'.

Emacs finds a word boundary between characters of the same script if they have categories matching some element of this list.

More precisely, if an element of this list is a cons of category CAT1 and CAT2, and a multibyte character C1 which has CAT1 but not CAT2 is followed by C2 which has CAT2 but not CAT1, there's a word boundary between C1 and C2.

For instance, to tell that there's a word boundary between Hiragana and Katakana (both are in the same script `kana'), the element `(?H . ?K) should be in this list.

(defvar word-combining-categories nil)
(fns/put 'category-table 'char-table-extra-slots 2)

Return the standard category table. This is the one used for new buffers.

(defun standard-category-table ())

Construct a new and empty category table and return it.

(defun make-category-table ())

Construct a new category table and return it. It is a copy of the TABLE, which defaults to the standard category table.

(defun copy-category-table (&optional table))

Return the category set of CHAR.

(defun char-category-set (char))

Return a newly created category-set which contains CATEGORIES. CATEGORIES is a string of category mnemonics. The value is a bool-vector which has t at the indices corresponding to those categories.

(defun make-category-set (categories))

Return a string containing mnemonics of the categories in CATEGORY-SET. CATEGORY-SET is a bool-vector, and the categories "in" it are those that are indexes where t occurs in the bool-vector. The return value is a string containing those same categories.

(defun category-set-mnemonics (category-set))

Specify TABLE as the category table for the current buffer. Return TABLE.

(defun set-category-table (table))

Return t if ARG is a category table.

(defun category-table-p (arg))

Return the current category table. This is the one specified by the current buffer.

(defun category-table ())

Modify the category set of CHARACTER by adding CATEGORY to it. The category is changed only for table TABLE, which defaults to the current buffer's category table. CHARACTER can be either a single character or a cons representing the lower and upper ends of an inclusive character range to modify. If optional fourth argument RESET is non-nil, then delete CATEGORY from the category set instead of adding it.

(defun modify-category-entry (character category &optional table reset))

Return the documentation string of CATEGORY, as defined in TABLE. TABLE should be a category table and defaults to the current buffer's category table.

(defun category-docstring (category &optional table))

Define CATEGORY as a category which is described by DOCSTRING. CATEGORY should be an ASCII printing character in the range ' to~'. DOCSTRING is the documentation string of the category. The first line should be a terse text (preferably less than 16 characters), and the rest lines should be the full description. The category is defined only in category table TABLE, which defaults to the current buffer's category table.

(defun define-category (category docstring &optional table))

Return a category which is not yet defined in TABLE. If no category remains available, return nil. The optional argument TABLE specifies which category table to modify; it defaults to the current buffer's category table.

(defun get-unused-category (&optional table))
 
(ns deuce.emacs.print
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns])
  (:refer-clojure :exclude [print]))

*Non-nil means print recursive structures using #N= and #N# syntax. If nil, printing proceeds recursively and may lead to `max-lisp-eval-depth' being exceeded or an error may occur: "Apparently circular structure being printed." Also see print-length' andprint-level'. If non-nil, shared substructures anywhere in the structure are printed with `#N=' before the first occurrence (in the order of the print representation) and `#N#' in place of each subsequent occurrence, where N is a positive decimal integer.

(defvar print-circle nil)

Non-nil means print uninterned symbols so they will read as uninterned. I.e., the value of (make-symbol "foobar") prints as #:foobar. When the uninterned symbol appears within a recursive data structure, and the symbol appears more than once, in addition use the #N# and #N= constructs as needed, so that multiple references to the same symbol are shared once again when the text is read back.

(defvar print-gensym nil)

A flag to control printing of `charset' text property on printing a string. The value must be nil, t, or `default'.

If the value is nil, don't print the text property `charset'.

If the value is t, always print the text property `charset'.

If the value is default', print the text propertycharset' only when the value is different from what is guessed in the current charset priorities.

(defvar print-charset-text-property nil)

Non-nil means print multibyte characters in strings as \xXXXX. (XXXX is the hex representation of the character code.) This affects only `prin1'.

(defvar print-escape-multibyte nil
  "Non-nil means print multibyte characters in strings as \\xXXXX.
  (XXXX is the hex representation of the character code.)
  This affects only `prin1'.")

Output stream `print' uses by default for outputting a character. This may be any function of one argument. It may also be a buffer (output is inserted before point) or a marker (output is inserted and the marker is advanced) or the symbol t (output appears in the echo area).

(defvar standard-output nil)

The format descriptor string used to print floats. This is a %-spec like those accepted by `printf' in C, but with some restrictions. It must start with the two characters `%.'. After that comes an integer precision specification, and then a letter which controls the format. The letters allowed are e',f' and `g'. Use `e' for exponential notation "DIG.DIGITSeEXPT" Use `f' for decimal point notation "DIGITS.DIGITS". Use `g' to choose the shorter of those two formats for the number at hand. The precision in any of these cases is the number of digits following the decimal point. With `f', a precision of 0 means to omit the decimal point. 0 is not allowed with e' org'.

A value of nil means to use the shortest notation that represents the number without losing information.

(defvar float-output-format nil)

Non-nil means print newlines in strings as `\n'. Also print formfeeds as `\f'.

(defvar print-escape-newlines nil
  "Non-nil means print newlines in strings as `\\n'.
  Also print formfeeds as `\\f'.")

Non-nil means print quoted forms with reader syntax. I.e., (quote foo) prints as 'foo, (function foo) as #'foo.

(defvar print-quoted nil)

*Non-nil means number continuously across print calls. This affects the numbers printed for #N= labels and #M# references. See also print-circle',print-gensym', and `print-number-table'. This variable should not be set with setq'; bind it with alet' instead.

(defvar print-continuous-numbering nil)

Maximum depth of list nesting to print before abbreviating. A value of nil means no limit. See also `eval-expression-print-level'.

(defvar print-level nil)

A vector used internally to produce #N=' labels and#N#' references. The Lisp printer uses this vector to detect Lisp objects referenced more than once.

When you bind `print-continuous-numbering' to t, you should probably also bind `print-number-table' to nil. This ensures that the value of `print-number-table' can be garbage-collected once the printing is done. If all elements of `print-number-table' are nil, it means that the printing done so far has not found any shared structure or objects that need to be recorded in the table.

(defvar print-number-table nil)

Maximum length of list to print before abbreviating. A value of nil means no limit. See also `eval-expression-print-length'.

(defvar print-length nil)

Non-nil means print unibyte non-ASCII chars in strings as \OOO. (OOO is the octal representation of the character code.) Only single-byte characters are affected, and only in `prin1'. When the output goes in a multibyte buffer, this feature is enabled regardless of the value of the variable.

(defvar print-escape-nonascii nil
  "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
  (OOO is the octal representation of the character code.)
  Only single-byte characters are affected, and only in `prin1'.
  When the output goes in a multibyte buffer, this feature is
  enabled regardless of the value of the variable.")

Convert an error value (ERROR-SYMBOL . DATA) to an error message. See Info anchor `(elisp)Definition of signal' for some details on how this error message is constructed.

(defun error-message-string (obj))

Output the printed representation of OBJECT, with newlines around it. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. For complex objects, the behavior is controlled by print-level' andprint-length', which see.

OBJECT is any of the Lisp data types: a number, a string, a symbol, a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.

Optional argument PRINTCHARFUN is the output stream, which can be one of these:

 - a buffer, in which case output is inserted into that buffer at point;
 - a marker, in which case output is inserted at marker's position;
 - a function, in which case that function is called once for each
   character of OBJECT's printed representation;
 - a symbol, in which case that symbol's function definition is called; or
 - t, in which case the output is displayed in the echo area.

If PRINTCHARFUN is omitted, the value of `standard-output' (which see) is used instead.

(defun print (object &optional printcharfun)
  (println object)
  object)

Redirect debugging output (stderr stream) to file FILE. If FILE is nil, reset target to the initial stderr stream. Optional arg APPEND non-nil (interactively, with prefix arg) means append to existing target file.

(defun redirect-debugging-output (file &optional append))

Output a newline to stream PRINTCHARFUN. If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.

(defun terpri (&optional printcharfun)
  (println)
  true)

Return a string containing the printed representation of OBJECT. OBJECT can be any Lisp object. This function outputs quoting characters when necessary to make output that `read' can handle, whenever possible, unless the optional second argument NOESCAPE is non-nil. For complex objects, the behavior is controlled by print-level' andprint-length', which see.

OBJECT is any of the Lisp data types: a number, a string, a symbol, a list, a buffer, a window, a frame, etc.

A pqrinted representation of an object is text which describes that object.

(defun prin1-to-string (object &optional noescape)
  (pr-str object))

Output the printed representation of OBJECT, any Lisp object. Quoting characters are printed when needed to make output that `read' can handle, whenever this is possible. For complex objects, the behavior is controlled by print-level' andprint-length', which see.

OBJECT is any of the Lisp data types: a number, a string, a symbol, a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.

Optional argument PRINTCHARFUN is the output stream, which can be one of these:

 - a buffer, in which case output is inserted into that buffer at point;
 - a marker, in which case output is inserted at marker's position;
 - a function, in which case that function is called once for each
   character of OBJECT's printed representation;
 - a symbol, in which case that symbol's function definition is called; or
 - t, in which case the output is displayed in the echo area.

If PRINTCHARFUN is omitted, the value of `standard-output' (which see) is used instead.

(defun prin1 (object &optional printcharfun)
  (let [printcharfun (or printcharfun (data/symbol-value 'standard-output))
        s (prin1-to-string object)]
    (condp some [printcharfun]
      #{nil true} (editfns/message s)
      data/bufferp (binding [buffer/*current-buffer* printcharfun]
                     (editfns/insert s)))))

Write CHARACTER to stderr. You can call print while debugging emacs, and pass it this function to make it write to the debugging output.

(defun external-debugging-output (character))

Output the printed representation of OBJECT, any Lisp object. No quoting characters are used; no delimiters are printed around the contents of strings.

OBJECT is any of the Lisp data types: a number, a string, a symbol, a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.

Optional argument PRINTCHARFUN is the output stream, which can be one of these:

 - a buffer, in which case output is inserted into that buffer at point;
 - a marker, in which case output is inserted at marker's position;
 - a function, in which case that function is called once for each
   character of OBJECT's printed representation;
 - a symbol, in which case that symbol's function definition is called; or
 - t, in which case the output is displayed in the echo area.

If PRINTCHARFUN is omitted, the value of `standard-output' (which see) is used instead.

(defun princ (object &optional printcharfun)
  (println object))

Output character CHARACTER to stream PRINTCHARFUN. PRINTCHARFUN defaults to the value of `standard-output' (which see).

(defun write-char (character &optional printcharfun))
 
(ns deuce.emacs.xfaces
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Alist of fonts vs the rescaling factors. Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where FONT-PATTERN is a font-spec or a regular expression matching a font name, and RESCALE-RATIO is a floating point number to specify how much larger (or smaller) font we should use. For instance, if a face requests a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point.

(defvar face-font-rescale-alist nil)

Alist of face remappings. Each element is of the form:

 (FACE . REPLACEMENT),

which causes display of the face FACE to use REPLACEMENT instead. REPLACEMENT is a face specification, i.e. one of the following:

(1) a face name
(2) a property list of attribute/value pairs, or
(3) a list in which each element has the form of (1) or (2).

List values for REPLACEMENT are merged to form the final face specification, with earlier entries taking precedence, in the same as as in the `face' text property.

Face-name remapping cycles are suppressed; recursive references use the underlying face instead of the remapped face. So a remapping of the form:

 (FACE EXTRA-FACE... FACE)

or:

 (FACE (FACE-ATTR VAL ...) FACE)

causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be merged with the existing definition of FACE. Note that this isn't necessary for the default face, since every face inherits from the default face.

If this variable is made buffer-local, the face remapping takes effect only in that buffer. For instance, the mode my-mode could define a face `my-mode-default', and then in the mode setup function, do:

 (set (make-local-variable 'face-remapping-alist)
'((default my-mode-default)))).

Because Emacs normally only redraws screen areas when the underlying buffer contents change, you may need to call `redraw-display' after changing this variable for it to take effect.

(defvar face-remapping-alist nil)

An alist of defined terminal colors and their RGB values. See the docstring of `tty-color-alist' for the details.

(defvar tty-defined-color-alist nil)

*Default stipple pattern used on monochrome displays. This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable.

(defvar face-default-stipple nil)

*Limit for font matching. If an integer > 0, font matching functions won't load more than that number of fonts when searching for a matching font.

(defvar font-list-limit nil)

Allowed scalable fonts. A value of nil means don't allow any scalable fonts. A value of t means allow any scalable font. Otherwise, value must be a list of regular expressions. A font may be scaled if its name matches a regular expression in the list. Note that if value is nil, a scalable font might still be used, if no other font of the appropriate family and registry is available.

You can customize this variable.

(defvar scalable-fonts-allowed nil)

List of ignored fonts. Each element is a regular expression that matches names of fonts to ignore.

(defvar face-ignored-fonts nil)

List of global face definitions (for internal use only.)

(defvar face-new-frame-defaults nil)

Make FACE, a symbol, a Lisp face with all attributes nil. If FACE was not known as a face before, create a new one. If optional argument FRAME is specified, make a frame-local face for that frame. Otherwise operate on the global face definition. Value is a vector of face attributes.

(defun internal-make-lisp-face (face &optional frame)
  nil)

Return non-nil if all the face attributes in ATTRIBUTES are supported. The optional argument DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display).

The definition of `supported' is somewhat heuristic, but basically means that a face containing all the attributes in ATTRIBUTES, when merged with the default face for display, can be represented in a way that's

(1) different in appearance than the default face, and (2) `close in spirit' to what the attributes specify, if not exact.

Point (2) implies that a `:weight black' attribute will be satisfied by any display that can display bold, and a `:foreground "yellow"' as long as it can display a yellowish color, but `:slant italic' will not be satisfied by the tty display code's automatic substitution of a `dim' face for italic.

(defun display-supports-face-attributes-p (attributes &optional display)
  nil)

Check whether a face attribute value is relative. Specifically, this function returns t if the attribute ATTRIBUTE with the value VALUE is relative.

A relative value is one that doesn't entirely override whatever is inherited from another face. For most possible attributes, the only relative value that users see is `unspecified'. However, for :height, floating point values are also relative.

(defun face-attribute-relative-p (attribute value))

Return non-nil if COLOR can be displayed on FRAME. BACKGROUND-P non-nil means COLOR is used as a background. Otherwise, this function tells whether it can be used as a foreground. If FRAME is nil or omitted, use the selected frame. COLOR must be a valid color name.

(defun color-supported-p (color &optional frame background-p))

Create an alist of color entries from an external file.

The file should define one named RGB color per line like so: R G B name where R,G,B are numbers between 0 and 255 and name is an arbitrary string.

(defun x-load-color-file (filename))

True if FACE has no attribute specified. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame.

(defun internal-lisp-face-empty-p (face &optional frame))

Set attribute ATTR of FACE to VALUE. FRAME being a frame means change the face on that frame. FRAME nil means change the face of the selected frame. FRAME t means change the default for new frames. FRAME 0 means change the face on all frames, and change the default for new frames.

(defun internal-set-lisp-face-attribute (face attr value &optional frame)
  nil)

Clear face caches on all frames. Optional THOROUGHLY non-nil means try to free unused fonts, too.

(defun clear-face-cache (&optional thoroughly))

Define alternative font registries to try in face font selection. ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries. Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can be found. Value is ALIST.

(defun internal-set-alternative-font-registry-alist (alist)
  nil)

Return face ATTRIBUTE VALUE1 merged with VALUE2. If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then the result will be absolute, otherwise it will be relative.

(defun merge-face-attribute (attribute value1 value2))

Return non-nil if COLOR is a shade of gray (or white or black). FRAME specifies the frame and thus the display for interpreting COLOR. If FRAME is nil or omitted, use the selected frame.

(defun color-gray-p (color &optional frame))

Suppress/allow boldness of faces with inverse default colors. SUPPRESS non-nil means suppress it. This affects bold faces on TTYs whose foreground is the default background color of the display and whose background is the default foreground color. For such faces, the bold face attribute is ignored if this variable is non-nil.

(defun tty-suppress-bold-inverse-default-colors (suppress))

Add attributes from frame-default definition of FACE to FACE on FRAME. Default face attributes override any local face attributes.

(defun internal-merge-in-global-face (face frame))

Return the font name of face FACE, or nil if it is unspecified. The font name is, by default, for ASCII characters. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). The font default for a face is either nil, or a list of the form (bold), (italic) or (bold italic). If FRAME is omitted or nil, use the selected frame. And, in this case, if the optional third argument CHARACTER is given, return the font name used for CHARACTER.

(defun face-font (face &optional frame character))

Return a list of valid discrete values for face attribute ATTR. Value is nil if ATTR doesn't have a discrete set of valid values.

(defun internal-lisp-face-attribute-values (attr))

True if FACE1 and FACE2 are equal. If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame. If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames). If FRAME is omitted or nil, use the selected frame.

(defun internal-lisp-face-equal-p (face1 face2 &optional frame))

Set font selection order for face font selection to ORDER. ORDER must be a list of length 4 containing the symbols `:width', :height',:weight', and `:slant'. Face attributes appearing first in ORDER are matched first, e.g. if `:height' appears before `:weight' in ORDER, font selection first tries to find a font with a suitable height, and then tries to match the font weight. Value is ORDER.

(defun internal-set-font-selection-order (order))

Return non-nil if FACE names a face. FACE should be a symbol or string. If optional second argument FRAME is non-nil, check for the existence of a frame-local face with name FACE on that frame. Otherwise check for the existence of a global face.

(defun internal-lisp-face-p (face &optional frame)
  nil)

Copy face FROM to TO. If FRAME is t, copy the global face definition of FROM. Otherwise, copy the frame-local definition of FROM on FRAME. If NEW-FRAME is a frame, copy that data into the frame-local definition of TO on NEW-FRAME. If NEW-FRAME is nil, FRAME controls where the data is copied to.

The value is TO.

(defun internal-copy-lisp-face (from to frame new-frame))

Return an alist of frame-local faces defined on FRAME. For internal use only.

(defun frame-face-alist (&optional frame))

Define alternative font families to try in face font selection. ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries. Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can be found. Value is ALIST.

(defun internal-set-alternative-font-family-alist (alist))

Return a vector of face attributes corresponding to PLIST.

(defun face-attributes-as-vector (plist))

Return face attribute KEYWORD of face SYMBOL. If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid face attribute name, signal an error. If the optional argument FRAME is given, report on face SYMBOL in that frame. If FRAME is t, report on the defaults for face SYMBOL (for new frames). If FRAME is omitted or nil, use the selected frame.

(defun internal-get-lisp-face-attribute (symbol keyword &optional frame))

Return an integer distance between COLOR1 and COLOR2 on FRAME. COLOR1 and COLOR2 may be either strings containing the color name, or lists of the form (RED GREEN BLUE). If FRAME is unspecified or nil, the current frame is used.

(defun color-distance (color1 color2 &optional frame))
 
(ns deuce.emacs.macros
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Last kbd macro defined, as a string or vector; nil if none defined.

(defvar last-kbd-macro nil)

Non-nil while a keyboard macro is being defined. Don't set this! The value is the symbol `append' while appending to the definition of an existing macro.

(defvar defining-kbd-macro nil)

Normal hook run whenever a keyboard macro terminates. This is run whether the macro ends normally or prematurely due to an error.

(defvar kbd-macro-termination-hook nil)

Index in currently executing keyboard macro; undefined if none executing.

(defvar executing-kbd-macro-index nil)

Currently executing keyboard macro (string or vector). This is nil when not executing a keyboard macro.

(defvar executing-kbd-macro nil)

Record subsequent keyboard input, defining a keyboard macro. The commands are recorded even as they are executed. Use M-x end-kbd-macro to finish recording and make the macro available. Use M-x name-last-kbd-macro to give it a permanent name. Non-nil arg (prefix arg) means append to last macro defined; this begins by re-executing that macro as if you typed it again. If optional second arg, NO-EXEC, is non-nil, do not re-execute last macro before appending to it.

(defun start-kbd-macro (append &optional no-exec)
  (interactive "P"))

Record subsequent keyboard input, defining a keyboard macro. The commands are recorded even as they are executed. Use M-x end-kbd-macro to finish recording and make the macro available. Use M-x name-last-kbd-macro to give it a permanent name. Non-nil arg (prefix arg) means append to last macro defined; this begins by re-executing that macro as if you typed it again. If optional second arg, NO-EXEC, is non-nil, do not re-execute last macro before appending to it.

(defun defining-kbd-macro (append &optional no-exec))

Execute MACRO as string of editor command characters. If MACRO is a symbol, its function definition is used. COUNT is a repeat count, or nil for once, or 0 for infinite loop.

Optional third arg LOOPFUNC may be a function that is called prior to each iteration of the macro. Iteration stops if LOOPFUNC returns nil.

(defun execute-kbd-macro (macro &optional count loopfunc))

Finish defining a keyboard macro. The definition was started by M-x start-kbd-macro. The macro is now available for use via M-x call-last-kbd-macro, or it can be given a name with M-x name-last-kbd-macro and then invoked under that name.

With numeric arg, repeat macro now that many times, counting the definition just completed as the first repetition. An argument of zero means repeat until error.

In Lisp, optional second arg LOOPFUNC may be a function that is called prior to each iteration of the macro. Iteration stops if LOOPFUNC returns nil.

(defun end-kbd-macro (&optional repeat loopfunc)
  (interactive "p"))

Call the last keyboard macro that you defined with M-x start-kbd-macro.

A prefix argument serves as a repeat count. Zero means repeat until error.

To make a macro permanent so you can call it even after defining others, use M-x name-last-kbd-macro.

In Lisp, optional second arg LOOPFUNC may be a function that is called prior to each iteration of the macro. Iteration stops if LOOPFUNC returns nil.

(defun call-last-kbd-macro (&optional prefix loopfunc)
  (interactive "p"))

Cancel the events added to a keyboard macro for this command.

(defun cancel-kbd-macro-events ())

Store EVENT into the keyboard macro being defined.

(defun store-kbd-macro-event (event))
 
(ns deuce.emacs.dired
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.java.io :as io]
            [deuce.emacs-lisp.cons :as cons])
  (:import [java.io File])
  (:refer-clojure :exclude []))

Completion ignores file names ending in any string in this list. It does not ignore them if all possible completions end in one of these strings or when displaying a list of completions. It ignores directory names if they match any string in this list which ends in a slash.

You can customize this variable.

(defvar completion-ignored-extensions nil)

Return a list of attributes of file FILENAME. Value is nil if specified file cannot be opened.

ID-FORMAT specifies the preferred format of attributes uid and gid (see below) - valid values are 'string and 'integer. The latter is the default, but we plan to change that, so you should specify a non-nil value for ID-FORMAT if you use the returned uid or gid.

Elements of the attribute list are: 0. t for directory, string (name linked to) for symbolic link, or nil. 1. Number of links to file. 2. File uid as a string or a number. If a string value cannot be looked up, a numeric value, either an integer or a float, is returned. 3. File gid, likewise. 4. Last access time, as a list of two integers. First integer has high-order 16 bits of time, second has low 16 bits. (See a note below about access time on FAT-based filesystems.) 5. Last modification time, likewise. This is the time of the last change to the file's contents. 6. Last status change time, likewise. This is the time of last change to the file's attributes: owner and group, access mode bits, etc. 7. Size in bytes. This is a floating point number if the size is too large for an integer. 8. File modes, as a string of ten letters or dashes as in ls -l. 9. t if file's gid would change if file were deleted and recreated. 10. inode number. If it is larger than what an Emacs integer can hold, this is of the form (HIGH . LOW): first the high bits, then the low 16 bits. If even HIGH is too large for an Emacs integer, this is instead of the form (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits, and finally the low 16 bits. 11. Filesystem device number. If it is larger than what the Emacs integer can hold, this is a cons cell, similar to the inode number.

On most filesystems, the combination of the inode and the device number uniquely identifies the file.

On MS-Windows, performance depends on `w32-get-true-file-attributes', which see.

On some FAT-based filesystems, only the date of last access is recorded, so last access time will always be midnight of that day.

(defun file-attributes (filename &optional id-format))

Return a list of names of files in DIRECTORY. There are three optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. If MATCH is non-nil, mention only file names that match the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. Otherwise, the list returned is sorted with `string-lessp'. NOSORT is useful if you plan to sort the result yourself.

(defun directory-files (directory &optional full match nosort)
  (cons/maybe-seq
   ((if nosort identity sort)
    (filter (if match
              #(re-find (re-pattern
                         ((ns-resolve 'deuce.emacs.search
                                      'emacs-regex-to-java) match)) %)
              identity)
            (map (fn [^File f]
                   (if full
                     (.getCanonicalPath f)
                     (.getName f)))
                 (.listFiles (io/file directory)))))))

Complete file name FILE in directory DIRECTORY. Returns the longest string common to all file names in DIRECTORY that start with FILE. If there is only one and FILE matches it exactly, returns t. Returns nil if DIRECTORY contains no name starting with FILE.

If PREDICATE is non-nil, call PREDICATE with each possible completion (in absolute form) and ignore it if PREDICATE returns nil.

This function ignores some of the possible completions as determined by the variable `completion-ignored-extensions', which see.

(defun file-name-completion (file directory &optional predicate))

Return a list of all completions of file name FILE in directory DIRECTORY. These are all file names in directory DIRECTORY which begin with FILE.

(defun file-name-all-completions (file directory))

Return t if first arg file attributes list is less than second. Comparison is in lexicographic order and case is significant.

(defun file-attributes-lessp (f1 f2))

Return a list of names of files and their attributes in DIRECTORY. There are four optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. If MATCH is non-nil, mention only file names that match the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. NOSORT is useful if you plan to sort the result yourself. ID-FORMAT specifies the preferred format of attributes uid and gid, see `file-attributes' for further documentation. On MS-Windows, performance depends on `w32-get-true-file-attributes', which see.

(defun directory-files-and-attributes (directory &optional full match nosort id-format))
 
(ns deuce.emacs.undo
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Don't keep more than this much size of undo information. This limit is applied when garbage collection happens. When a previous command increases the total undo list size past this value, that command and the earlier commands that came before it are forgotten. However, the most recent buffer-modifying command's undo info is never discarded for this reason.

The size is counted as the number of bytes occupied, which includes both saved text and other data.

You can customize this variable.

(defvar undo-strong-limit nil)

Keep no more undo information once it exceeds this size. This limit is applied when garbage collection happens. When a previous command increases the total undo list size past this value, the earlier commands that came before it are forgotten.

The size is counted as the number of bytes occupied, which includes both saved text and other data.

You can customize this variable.

(defvar undo-limit nil)

Outer limit on size of undo information for one command. At garbage collection time, if the current command has produced more than this much undo information, it discards the info and displays a warning. This is a last-ditch limit to prevent memory overflow.

The size is counted as the number of bytes occupied, which includes both saved text and other data. A value of nil means no limit. In this case, accumulating one huge undo entry could make Emacs crash as a result of memory overflow.

In fact, this calls the function which is the value of `undo-outer-limit-function' with one argument, the size. The text above describes the behavior of the function that variable usually specifies.

You can customize this variable.

(defvar undo-outer-limit nil)

Non-nil means do not record point' inbuffer-undo-list'.

(defvar undo-inhibit-record-point nil)

Function to call when an undo list exceeds `undo-outer-limit'. This function is called with one argument, the current undo list size for the most recent command (since the last undo boundary). If the function returns t, that means truncation has been fully handled. If it returns nil, the other forms of truncation are done.

Garbage collection is inhibited around the call to this function, so it must make sure not to do a lot of consing.

(defvar undo-outer-limit-function nil)

Mark a boundary between units of undo. An undo command will stop at this point, but another undo command will undo to the previous boundary.

(defun undo-boundary ())

Undo N records from the front of the list LIST. Return what remains of the list.

(defun primitive-undo (n list))
 
(ns deuce.emacs.charset
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.fns :as fns]
            [deuce.emacs-lisp.globals :as globals])
  (:refer-clojure :exclude []))

Inhibit loading of charset maps. Used when dumping Emacs.

(defvar inhibit-load-charset-map nil)

ISO639 language mnemonic symbol for the current language environment. If the current language environment is for multiple languages (e.g. "Latin-1"), the value may be a list of mnemonics.

(defvar current-iso639-language nil)

List of all charsets ever defined.

(defvar charset-list (alloc/list))

*List of directories to search for charset map files.

You can customize this variable.

(defvar charset-map-path nil)

Sort charset list CHARSETS by a priority of each charset. Return the sorted list. CHARSETS is modified by side effects. See also charset-priority-list' andset-charset-priority'.

(defun sort-charsets (charsets))

Return the property list of CHARSET.

(defun charset-plist (charset))

Set CHARSET's property list to PLIST.

(defun set-charset-plist (charset plist))

Return charset of a character in the current buffer at position POS. If POS is nil, it defaults to the current point. If POS is out of range, the value is nil.

(defun charset-after (&optional pos))

For internal use only.

(defun define-charset-internal (&rest args))

Define ALIAS as an alias for charset CHARSET.

(defun define-charset-alias (alias charset))

Return non-nil if and only if OBJECT is a charset.

(defun charsetp (object))

Encode the character CH into a code-point of CHARSET. Return nil if CHARSET doesn't include CH.

Optional argument RESTRICTION specifies a way to map CH to a code-point in CCS. Currently not supported and just ignored.

(defun encode-char (ch charset &optional restriction))

Internal use only. Return charset identification number of CHARSET.

(defun charset-id-internal (&optional charset))

Return list of charset and one to four position-codes of CH. The charset is decided by the current priority order of charsets. A position-code is a byte value of each dimension of the code-point of CH in the charset.

(defun split-char (ch))

Return a list of charsets in the region between BEG and END. BEG and END are buffer positions. Optional arg TABLE if non-nil is a translation table to look up.

If the current buffer is unibyte, the returned list may contain only ascii',eight-bit-control', and `eight-bit-graphic'.

(defun find-charset-region (beg end &optional table))

Unify characters of CHARSET with Unicode. This means reading the relevant file and installing the table defined by CHARSET's `:unify-map' property.

Optional second arg UNIFY-MAP is a file name string or a vector. It has the same meaning as the `:unify-map' attribute in the function `define-charset' (which see).

Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET.

(defun unify-charset (charset &optional unify-map deunify)
  nil)

Return a list of charsets in STR. Optional arg TABLE if non-nil is a translation table to look up.

If STR is unibyte, the returned list may contain only ascii',eight-bit-control', and `eight-bit-graphic'.

(defun find-charset-string (str &optional table))

Assign higher priority to the charsets given as arguments.

(defun set-charset-priority (&rest charsets))

Declare an equivalent charset for ISO-2022 decoding.

On decoding by an ISO-2022 base coding system, when a charset specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as if CHARSET is designated instead.

(defun declare-equiv-charset (dimension chars final-char charset))

Internal use only. Clear temporary charset mapping tables. It should be called only from temacs invoked for dumping.

(defun clear-charset-maps ())

Return an unused ISO final char for a charset of DIMENSION and CHARS. DIMENSION is the number of bytes to represent a character: 1 or 2. CHARS is the number of characters in a dimension: 94 or 96.

This final char is for private use, thus the range is 0' (48) ..?' (63). If there's no unused final char for the specified kind of charset, return nil.

(defun get-unused-iso-final-char (dimension chars))

Return the list of charsets ordered by priority. HIGHESTP non-nil means just return the highest priority one.

(defun charset-priority-list (&optional highestp))

Call FUNCTION for all characters in CHARSET. FUNCTION is called with an argument RANGE and the optional 3rd argument ARG.

RANGE is a cons (FROM . TO), where FROM and TO indicate a range of characters contained in CHARSET.

The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the range of code points (in CHARSET) of target characters.

(defun map-charset-chars (function charset &optional arg from-code to-code))

Return a character of CHARSET whose position codes are CODEn.

CODE1 through CODE4 are optional, but if you don't supply sufficient position codes, it is assumed that the minimum code in each dimension is specified.

(defun make-char (charset &optional code1 code2 code3 code4))

Return the charset of highest priority that contains CH. If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets from which to find the charset. It may also be a coding system. In that case, find the charset from what supported by that coding system.

(defun char-charset (ch &optional restriction))

Decode the pair of CHARSET and CODE-POINT into a character. Return nil if CODE-POINT is not valid in CHARSET.

CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).

Optional argument RESTRICTION specifies a way to map the pair of CCS and CODE-POINT to a character. Currently not supported and just ignored.

(defun decode-char (charset code-point &optional restriction))

Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.

ISO 2022's designation sequence (escape sequence) distinguishes charsets by their DIMENSION, CHARS, and FINAL-CHAR, whereas Emacs distinguishes them by charset symbol. See the documentation of the function `charset-info' for the meanings of DIMENSION, CHARS, and FINAL-CHAR.

(defun iso-charset (dimension chars final-char))
 
(ns deuce.emacs.process
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.java.shell :as sh])
  (:refer-clojure :exclude []))

*Non-nil means delete processes immediately when they exit. A value of nil means don't delete them until `list-processes' is run.

You can customize this variable.

(defvar delete-exited-processes nil)

Control type of device used to communicate with subprocesses. Values are nil to use a pipe, or t or `pty' to use a pty. The value has no effect if the system has no ptys or if all ptys are busy: then a pipe is used in any case. The value takes effect when `start-process' is called.

(defvar process-connection-type nil)

If non-nil, improve receive buffering by delaying after short reads. On some systems, when Emacs reads the output from a subprocess, the output data is read in very small blocks, potentially resulting in very poor performance. This behavior can be remedied to some extent by setting this variable to a non-nil value, as it will automatically delay reading from such processes, to allow them to produce more output before Emacs tries to read it. If the value is t, the delay is reset after each write to the process; any other non-nil value means that the delay is not reset on write. The variable takes effect when `start-process' is called.

(defvar process-adaptive-read-buffering nil)

Delete PROCESS: kill it and forget about it immediately. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process.

(defun delete-process (process))

Send PROCESS the signal with code SIGCODE. PROCESS may also be a number specifying the process id of the process to signal; in this case, the process need not be a child of this Emacs. SIGCODE may be an integer, or a symbol whose name is a signal name.

(defun signal-process (process sigcode)
  (interactive "sProcess (name or number): \nnSignal code: "))

Give PROCESS the sentinel SENTINEL; nil for none. The sentinel is called as a function when the process changes state. It gets two arguments: the process, and a string describing the change.

(defun set-process-sentinel (process sentinel))

Continue process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. If PROCESS is a network or serial process, resume handling of incoming traffic.

(defun continue-process (&optional process current-group))

Return the exit status of PROCESS or the signal number that killed it. If PROCESS has not yet exited or died, return 0.

(defun process-exit-status (process))

Tell PROCESS that it has logical window size HEIGHT and WIDTH.

(defun set-process-window-size (process height width))

Return attributes of the process given by its PID, a number.

Value is an alist where each element is a cons cell of the form

  (KEY . VALUE)

If this functionality is unsupported, the value is nil.

See `list-system-processes' for getting a list of all process IDs.

The KEYs of the attributes that this function may return are listed below, together with the type of the associated VALUE (in parentheses). Not all platforms support all of these attributes; unsupported attributes will not appear in the returned alist. Unless explicitly indicated otherwise, numbers can have either integer or floating point values.

euid -- Effective user User ID of the process (number) user -- User name corresponding to euid (string) egid -- Effective user Group ID of the process (number) group -- Group name corresponding to egid (string) comm -- Command name (executable name only) (string) state -- Process state code, such as "S", "R", or "T" (string) ppid -- Parent process ID (number) pgrp -- Process group ID (number) sess -- Session ID, i.e. process ID of session leader (number) ttname -- Controlling tty name (string) tpgid -- ID of foreground process group on the process's tty (number) minflt -- number of minor page faults (number) majflt -- number of major page faults (number) cminflt -- cumulative number of minor page faults (number) cmajflt -- cumulative number of major page faults (number) utime -- user time used by the process, in the (HIGH LOW USEC) format stime -- system time used by the process, in the (HIGH LOW USEC) format time -- sum of utime and stime, in the (HIGH LOW USEC) format cutime -- user time used by the process and its children, (HIGH LOW USEC) cstime -- system time used by the process and its children, (HIGH LOW USEC) ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format pri -- priority of the process (number) nice -- nice value of the process (number) thcount -- process thread count (number) start -- time the process started, in the (HIGH LOW USEC) format vsize -- virtual memory size of the process in KB's (number) rss -- resident set size of the process in KB's (number) etime -- elapsed time the process is running, in (HIGH LOW USEC) format pcpu -- percents of CPU time used by the process (floating-point number) pmem -- percents of total physical memory used by process's resident set (floating-point number) args -- command line which invoked the process (string).

(defun process-attributes (pid))

Create and return a network server or client process.

In Emacs, network connections are represented by process objects, so input and output work as for subprocesses and `delete-process' closes a network connection. However, a network process has no process id, it cannot be signaled, and the status codes are different from normal processes.

Arguments are specified as keyword/argument pairs. The following arguments are defined:

:name NAME -- NAME is name for process. It is modified if necessary to make it unique.

:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer.

:host HOST -- HOST is name of the host to connect to, or its IP address. The symbol `local' specifies the local host. If specified for a server process, it must be a valid name or address for the local host, and only clients connecting to that address will be accepted.

:service SERVICE -- SERVICE is name of the service desired, or an integer specifying a port number to connect to. If SERVICE is t, a random port number is selected for the server. (If Emacs was compiled with getaddrinfo, a port number can also be specified as a string, e.g. "80", as well as an integer. This is not portable.)

:type TYPE -- TYPE is the type of connection. The default (nil) is a stream type connection, `datagram' creates a datagram type connection, `seqpacket' creates a reliable datagram connection.

:family FAMILY -- FAMILY is the address (and protocol) family for the service specified by HOST and SERVICE. The default (nil) is to use whatever address family (IPv4 or IPv6) that is defined for the host and port number specified by HOST and SERVICE. Other address families supported are: local -- for a local (i.e. UNIX) address specified by SERVICE. ipv4 -- use IPv4 address family only. ipv6 -- use IPv6 address family only.

:local ADDRESS -- ADDRESS is the local address used for the connection. This parameter is ignored when opening a client process. When specified for a server process, the FAMILY, HOST and SERVICE args are ignored.

:remote ADDRESS -- ADDRESS is the remote partner's address for the connection. This parameter is ignored when opening a stream server process. For a datagram server process, it specifies the initial setting of the remote datagram address. When specified for a client process, the FAMILY, HOST, and SERVICE args are ignored.

The format of ADDRESS depends on the address family: - An IPv4 address is represented as an vector of integers [A B C D P] corresponding to numeric IP address A.B.C.D and port number P. - A local address is represented as a string with the address in the local address space. - An "unsupported family" address is represented by a cons (F . AV) where F is the family number and AV is a vector containing the socket address data with one element per address data byte. Do not rely on this format in portable code, as it may depend on implementation defined constants, data sizes, and data structure alignment.

:coding CODING -- If CODING is a symbol, it specifies the coding system used for both reading and writing for this process. If CODING is a cons (DECODING . ENCODING), DECODING is used for reading, and ENCODING is used for writing.

:nowait BOOL -- If BOOL is non-nil for a stream type client process, return without waiting for the connection to complete; instead, the sentinel function will be called with second arg matching "open" (if successful) or "failed" when the connect completes. Default is to use a blocking connect (i.e. wait) for stream type connections.

:noquery BOOL -- Query the user unless BOOL is non-nil, and process is running when Emacs is exited.

:stop BOOL -- Start process in the `stopped' state if BOOL non-nil. In the stopped state, a server process does not accept new connections, and a client process does not handle incoming traffic. The stopped state is cleared by `continue-process' and set by `stop-process'.

:filter FILTER -- Install FILTER as the process filter.

:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the process filter are multibyte, otherwise they are unibyte. If this keyword is not specified, the strings are multibyte if the default value of `enable-multibyte-characters' is non-nil.

:sentinel SENTINEL -- Install SENTINEL as the process sentinel.

:log LOG -- Install LOG as the server process log function. This function is called when the server accepts a network connection from a client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER is the server process, CLIENT is the new process for the connection, and MESSAGE is a string.

:plist PLIST -- Install PLIST as the new process' initial plist.

:server QLEN -- if QLEN is non-nil, create a server process for the specified FAMILY, SERVICE, and connection type (stream or datagram). If QLEN is an integer, it is used as the max. length of the server's pending connection queue (also known as the backlog); the default queue length is 5. Default is to create a client process.

The following network options can be specified for this connection:

:broadcast BOOL -- Allow send and receive of datagram broadcasts. :dontroute BOOL -- Only send to directly connected hosts. :keepalive BOOL -- Send keep-alive messages on network stream. :linger BOOL or TIMEOUT -- Send queued messages before closing. :oobinline BOOL -- Place out-of-band data in receive data stream. :priority INT -- Set protocol defined priority for sent packets. :reuseaddr BOOL -- Allow reusing a recently used local address (this is allowed by default for a server process). :bindtodevice NAME -- bind to interface NAME. Using this may require special privileges on some systems.

Consult the relevant system programmer's manual pages for more information on using these options.

A server process will listen for and accept connections from clients. When a client connection is accepted, a new network process is created for the connection with the following parameters:

  • The client's process name is constructed by concatenating the server process' NAME and a client identification string.
  • If the FILTER argument is non-nil, the client process will not get a separate process buffer; otherwise, the client's process buffer is a newly created buffer named after the server process' BUFFER name or process NAME concatenated with the client identification string.
  • The connection type and the process filter and sentinel parameters are inherited from the server process' TYPE, FILTER and SENTINEL.
  • The client process' contact info is set according to the client's addressing information (typically an IP address and a port number).
  • The client process' plist is initialized from the server's plist.

    Notice that the FILTER and SENTINEL args are never used directly by the server process. Also, the BUFFER argument is not used directly by the server process, but via the optional :log function, accepted (and failed) connections may be logged in the server process' buffer.

    The original argument list, modified with the actual connection information, is available via the `process-contact' function.

(defun make-network-process (&rest args))

Specify if query is needed for PROCESS when Emacs is exited. If the second argument FLAG is non-nil, Emacs will query the user before exiting or killing a buffer if PROCESS is running. This function returns FLAG.

(defun set-process-query-on-exit-flag (process flag))

Send QUIT signal to process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage.

(defun quit-process (&optional process current-group))

Return the name of the terminal PROCESS uses, or nil if none. This is the terminal that the process itself reads and writes on, not the name of the pty that Emacs uses to talk with that terminal.

(defun process-tty-name (process))

Stop process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. If PROCESS is a network or serial process, inhibit handling of incoming traffic.

(defun stop-process (&optional process current-group))

Send PROCESS the contents of STRING as input. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process. If STRING is more than 500 characters long, it is sent in several bunches. This may happen even for shorter strings. Output from processes can arrive in between bunches.

(defun process-send-string (process string))

Convert network ADDRESS from internal format to a string. A 4 or 5 element vector represents an IPv4 address (with port number). An 8 or 9 element vector represents an IPv6 address (with port number). If optional second argument OMIT-PORT is non-nil, don't include a port number in the string, even when present in ADDRESS. Returns nil if format of ADDRESS is invalid.

(defun format-network-address (address &optional omit-port))

Return information about network interface named IFNAME. The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS), where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address, NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and FLAGS is the current flags of the interface.

(defun network-interface-info (ifname))

Returns the filter function of PROCESS; nil if none. See `set-process-filter' for more info on filter functions.

(defun process-filter (process))

Return the value of inherit-coding-system flag for PROCESS. If this flag is t, `buffer-file-coding-system' of the buffer associated with PROCESS will inherit the coding system used to decode the process output.

(defun process-inherit-coding-system-flag (process))

This function is obsolete since 23.1.

Return t if a multibyte string is given to PROCESS's filter.

(defun process-filter-multibyte-p (process))

Return a cons of coding systems for decoding and encoding of PROCESS.

(defun process-coding-system (process))

Return the name of PROCESS, as a string. This is the name of the program invoked in PROCESS, possibly modified to make it unique among process names.

(defun process-name (process))

Set buffer associated with PROCESS to BUFFER (a buffer, or nil). Return BUFFER.

(defun set-process-buffer (process buffer))

Returns non-nil if Emacs is waiting for input from the user. This is intended for use by asynchronous process output filters and sentinels.

(defun waiting-for-user-input-p ())

Return the contact info of PROCESS; t for a real child. For a network or serial connection, the value depends on the optional KEY arg. If KEY is nil, value is a cons cell of the form (HOST SERVICE) for a network connection or (PORT SPEED) for a serial connection. If KEY is t, the complete contact information for the connection is returned, else the specific value for the keyword KEY is returned. See make-network-process' ormake-serial-process' for a list of keywords.

(defun process-contact (process &optional key))

Return the sentinel of PROCESS; nil if none. See `set-process-sentinel' for more info on sentinels.

(defun process-sentinel (process))

Send current contents of region as input to PROCESS. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process. Called from program, takes three arguments, PROCESS, START and END. If the region is more than 500 characters long, it is sent in several bunches. This may happen even for shorter regions. Output from processes can arrive in between bunches.

(defun process-send-region (process start end))

Get the current datagram address associated with PROCESS.

(defun process-datagram-address (process))

Return the status of PROCESS. The returned value is one of the following symbols: run -- for a process that is running. stop -- for a process stopped but continuable. exit -- for a process that has exited. signal -- for a process that has got a fatal signal. open -- for a network stream connection that is open. listen -- for a network stream server that is listening. closed -- for a network stream connection that is closed. connect -- when waiting for a non-blocking connection to complete. failed -- when a non-blocking connection has failed. nil -- if arg is a process name and no such process exists. PROCESS may be a process, a buffer, the name of a process, or nil, indicating the current buffer's process.

(defun process-status (process))

For network process PROCESS set option OPTION to value VALUE. See `make-network-process' for a list of options and values. If optional fourth arg NO-ERROR is non-nil, don't signal an error if OPTION is not a supported option, return nil instead; otherwise return t.

(defun set-network-process-option (process option value &optional no-error))

Return t if PROCESS has given the terminal to a child. If the operating system does not make it possible to find out, return t unconditionally.

(defun process-running-child-p (&optional process))

Return the buffer PROCESS is associated with. Output from PROCESS is inserted in this buffer unless PROCESS has a filter.

(defun process-buffer (process))

Return the process named NAME, or nil if there is none.

(defun get-process (name))

Give PROCESS the filter function FILTER; nil means no filter. A value of t means stop accepting output from the process.

When a process has a filter, its buffer is not used for output. Instead, each time it does output, the entire string of output is passed to the filter.

The filter gets two arguments: the process and the string of output. The string argument is normally a multibyte string, except: - if the process' input coding system is no-conversion or raw-text, it is a unibyte string (the non-converted input), or else - if `default-enable-multibyte-characters' is nil, it is a unibyte string (the result of converting the decoded input multibyte string to unibyte with `string-make-unibyte').

(defun set-process-filter (process filter))

Return t if OBJECT is a process.

(defun processp (object))

Return a list of numerical process IDs of all running processes. If this functionality is unsupported, return nil.

See `process-attributes' for getting attributes of a process given its ID.

(defun list-system-processes ())

Determine whether buffer of PROCESS will inherit coding-system. If the second argument FLAG is non-nil, then the variable `buffer-file-coding-system' of the buffer associated with PROCESS will be bound to the value of the coding system used to decode the process output.

This is useful when the coding system specified for the process buffer leaves either the character code conversion or the end-of-line conversion unspecified, or if the coding system used to decode the process output is more appropriate for saving the process buffer.

Binding the variable `inherit-process-coding-system' to non-nil before starting the process is an alternative way of setting the inherit flag for the process which will run.

This function returns FLAG.

(defun set-process-inherit-coding-system-flag (process flag))

Return a list of all processes.

(defun process-list ())

Return an alist of all network interfaces and their network address. Each element is a cons, the car of which is a string containing the interface name, and the cdr is the network address in internal format; see the description of ADDRESS in `make-network-process'.

(defun network-interface-list ())

Return the plist of PROCESS.

(defun process-plist (process))

Return the connection type of PROCESS. The value is either the symbol real',network', or `serial'. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process.

(defun process-type (process))

Return the marker for the end of the last output from PROCESS.

(defun process-mark (process))

Return the command that was executed to start PROCESS. This is a list of strings, the first string being the program executed and the rest of the strings being the arguments given to it. For a network or serial process, this is nil (process is running) or t (process is stopped).

(defun process-command (process))

Kill process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage.

(defun kill-process (&optional process current-group))

Set coding systems of PROCESS to DECODING and ENCODING. DECODING will be used to decode subprocess output and ENCODING to encode subprocess input.

(defun set-process-coding-system (process &optional decoding encoding))

Create and return a serial port process.

In Emacs, serial port connections are represented by process objects, so input and output work as for subprocesses, and `delete-process' closes a serial port connection. However, a serial process has no process id, it cannot be signaled, and the status codes are different from normal processes.

`make-serial-process' creates a process and a buffer, on which you probably want to use `process-send-string'. Try M-x serial-term for an interactive terminal. See below for examples.

Arguments are specified as keyword/argument pairs. The following arguments are defined:

:port PORT -- (mandatory) PORT is the path or name of the serial port. For example, this could be "/dev/ttyS0" on Unix. On Windows, this could be "COM1", or "\.\COM10" for ports higher than COM9 (double the backslashes in strings).

:speed SPEED -- (mandatory) is handled by `serial-process-configure', which this function calls.

:name NAME -- NAME is the name of the process. If NAME is not given, the value of PORT is used.

:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at the end of that buffer, unless you specify an output stream or filter function to handle the output. If BUFFER is not given, the value of NAME is used.

:coding CODING -- If CODING is a symbol, it specifies the coding system used for both reading and writing for this process. If CODING is a cons (DECODING . ENCODING), DECODING is used for reading, and ENCODING is used for writing.

:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and the process is running. If BOOL is not given, query before exiting.

:stop BOOL -- Start process in the `stopped' state if BOOL is non-nil. In the stopped state, a serial process does not accept incoming data, but you can send outgoing data. The stopped state is cleared by continue-process' and set bystop-process'.

:filter FILTER -- Install FILTER as the process filter.

:sentinel SENTINEL -- Install SENTINEL as the process sentinel.

:plist PLIST -- Install PLIST as the initial plist of the process.

:bytesize :parity :stopbits :flowcontrol -- This function calls `serial-process-configure' to handle these arguments.

The original argument list, possibly modified by later configuration, is available via the function `process-contact'.

Examples:

(make-serial-process :port "/dev/ttyS0" :speed 9600)

(make-serial-process :port "COM1" :speed 115200 :stopbits 2)

(make-serial-process :port "\.\COM13" :speed 1200 :bytesize 7 :parity 'odd)

(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)

(defun make-serial-process (&rest args)
  "Create and return a serial port process.
  In Emacs, serial port connections are represented by process objects,
  so input and output work as for subprocesses, and `delete-process'
  closes a serial port connection.  However, a serial process has no
  process id, it cannot be signaled, and the status codes are different
  from normal processes.
  `make-serial-process' creates a process and a buffer, on which you
  probably want to use `process-send-string'.  Try M-x serial-term for
  an interactive terminal.  See below for examples.
  Arguments are specified as keyword/argument pairs.  The following
  arguments are defined:
  :port PORT -- (mandatory) PORT is the path or name of the serial port.
  For example, this could be \"/dev/ttyS0\" on Unix.  On Windows, this
  could be \"COM1\", or \"\\\\.\\COM10\" for ports higher than COM9 (double
  the backslashes in strings).
  :speed SPEED -- (mandatory) is handled by `serial-process-configure',
  which this function calls.
  :name NAME -- NAME is the name of the process.  If NAME is not given,
  the value of PORT is used.
  :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
  with the process.  Process output goes at the end of that buffer,
  unless you specify an output stream or filter function to handle the
  output.  If BUFFER is not given, the value of NAME is used.
  :coding CODING -- If CODING is a symbol, it specifies the coding
  system used for both reading and writing for this process.  If CODING
  is a cons (DECODING . ENCODING), DECODING is used for reading, and
  ENCODING is used for writing.
  :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
  the process is running.  If BOOL is not given, query before exiting.
  :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
  In the stopped state, a serial process does not accept incoming data,
  but you can send outgoing data.  The stopped state is cleared by
  `continue-process' and set by `stop-process'.
  :filter FILTER -- Install FILTER as the process filter.
  :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
  :plist PLIST -- Install PLIST as the initial plist of the process.
  :bytesize
  :parity
  :stopbits
  :flowcontrol
  -- This function calls `serial-process-configure' to handle these
  arguments.
  The original argument list, possibly modified by later configuration,
  is available via the function `process-contact'.
  Examples:
  (make-serial-process :port \"/dev/ttyS0\" :speed 9600)
  (make-serial-process :port \"COM1\" :speed 115200 :stopbits 2)
  (make-serial-process :port \"\\\\.\\COM13\" :speed 1200 :bytesize 7 :parity 'odd)
  (make-serial-process :port \"/dev/tty.BlueConsole-SPP-1\" :speed nil)")

Configure speed, bytesize, etc. of a serial process.

Arguments are specified as keyword/argument pairs. Attributes that are not given are re-initialized from the process's current configuration (available via the function `process-contact') or set to reasonable default values. The following arguments are defined:

:process PROCESS :name NAME :buffer BUFFER :port PORT -- Any of these arguments can be given to identify the process that is to be configured. If none of these arguments is given, the current buffer's process is used.

:speed SPEED -- SPEED is the speed of the serial port in bits per second, also called baud rate. Any value can be given for SPEED, but most serial ports work only at a few defined values between 1200 and 115200, with 9600 being the most common value. If SPEED is nil, the serial port is not configured any further, i.e., all other arguments are ignored. This may be useful for special serial ports such as Bluetooth-to-serial converters which can only be configured through AT commands. A value of nil for SPEED can be used only when passed through make-serial-process' orserial-term'.

:bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.

:parity PARITY -- PARITY can be nil (don't use parity), the symbol odd' (use odd parity), or the symboleven' (use even parity). If PARITY is not given, no parity is used.

:stopbits STOPBITS -- STOPBITS is the number of stopbits used to terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS is not given or nil, 1 stopbit is used.

:flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of flowcontrol to be used, which is either nil (don't use flowcontrol), the symbol hw' (use RTS/CTS hardware flowcontrol), or the symbolsw' (use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no flowcontrol is used.

serial-process-configure' is called bymake-serial-process' for the initial configuration of the serial port.

Examples:

(serial-process-configure :process "/dev/ttyS0" :speed 1200)

(serial-process-configure :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)

(serial-process-configure :port "\.\COM13" :bytesize 7)

(defun serial-process-configure (&rest args)
  "Configure speed, bytesize, etc. of a serial process.
  Arguments are specified as keyword/argument pairs.  Attributes that
  are not given are re-initialized from the process's current
  configuration (available via the function `process-contact') or set to
  reasonable default values.  The following arguments are defined:
  :process PROCESS
  :name NAME
  :buffer BUFFER
  :port PORT
  -- Any of these arguments can be given to identify the process that is
  to be configured.  If none of these arguments is given, the current
  buffer's process is used.
  :speed SPEED -- SPEED is the speed of the serial port in bits per
  second, also called baud rate.  Any value can be given for SPEED, but
  most serial ports work only at a few defined values between 1200 and
  115200, with 9600 being the most common value.  If SPEED is nil, the
  serial port is not configured any further, i.e., all other arguments
  are ignored.  This may be useful for special serial ports such as
  Bluetooth-to-serial converters which can only be configured through AT
  commands.  A value of nil for SPEED can be used only when passed
  through `make-serial-process' or `serial-term'.
  :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
  can be 7 or 8.  If BYTESIZE is not given or nil, a value of 8 is used.
  :parity PARITY -- PARITY can be nil (don't use parity), the symbol
  `odd' (use odd parity), or the symbol `even' (use even parity).  If
  PARITY is not given, no parity is used.
  :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
  terminate a byte transmission.  STOPBITS can be 1 or 2.  If STOPBITS
  is not given or nil, 1 stopbit is used.
  :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
  flowcontrol to be used, which is either nil (don't use flowcontrol),
  the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
  (use XON/XOFF software flowcontrol).  If FLOWCONTROL is not given, no
  flowcontrol is used.
  `serial-process-configure' is called by `make-serial-process' for the
  initial configuration of the serial port.
  Examples:
  (serial-process-configure :process \"/dev/ttyS0\" :speed 1200)
  (serial-process-configure
      :buffer \"COM1\" :stopbits 1 :parity 'odd :flowcontrol 'hw)
  (serial-process-configure :port \"\\\\.\\COM13\" :bytesize 7)")

This function is obsolete since 23.1.

Set multibyteness of the strings given to PROCESS's filter. If FLAG is non-nil, the filter is given multibyte strings. If FLAG is nil, the filter is given unibyte strings. In this case, all character code conversion except for end-of-line conversion is suppressed.

(defun set-process-filter-multibyte (process flag))

Make PROCESS see end-of-file in its input. EOF comes after any text already sent to it. PROCESS may be a process, a buffer, the name of a process or buffer, or nil, indicating the current buffer's process. If PROCESS is a network connection, or is a process communicating through a pipe (as opposed to a pty), then you cannot send any more text to PROCESS after you call this function. If PROCESS is a serial process, wait until all output written to the process has been transmitted to the serial port.

(defun process-send-eof (&optional process))

Set the datagram address for PROCESS to ADDRESS. Returns nil upon error setting address, ADDRESS otherwise.

(defun set-process-datagram-address (process address))

Return the current value of query-on-exit flag for PROCESS.

(defun process-query-on-exit-flag (process))

Return the (or a) process associated with BUFFER. BUFFER may be a buffer or the name of one.

(defun get-buffer-process (buffer))

Return the process id of PROCESS. This is the pid of the external process which PROCESS uses or talks to. For a network connection, this value is nil.

(defun process-id (process))

Allow any pending output from subprocesses to be read by Emacs. It is read into the process' buffers or given to their filter functions. Non-nil arg PROCESS means do not return until some output has been received from PROCESS.

Non-nil second arg SECONDS and third arg MILLISEC are number of seconds and milliseconds to wait; return after that much time whether or not there is any subprocess output. If SECONDS is a floating point number, it specifies a fractional number of seconds to wait. The MILLISEC argument is obsolete and should be avoided.

If optional fourth arg JUST-THIS-ONE is non-nil, only accept output from PROCESS, suspending reading output from other processes. If JUST-THIS-ONE is an integer, don't run any timers either. Return non-nil if we received any output before the timeout expired.

(defun accept-process-output (&optional process seconds millisec just-this-one))

Start a program in a subprocess. Return the process object for it. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer name) to associate with the process.

Process output (both standard output and standard error streams) goes at end of BUFFER, unless you specify an output stream or filter function to handle the output. BUFFER may also be nil, meaning that this process is not associated with any buffer.

PROGRAM is the program file name. It is searched for in `exec-path' (which see). If nil, just associate a pty with the buffer. Remaining arguments are strings to give program as arguments.

If you want to separate standard output from standard error, invoke the command through a shell and redirect one of them using the shell syntax.

(defun start-process (name buffer program &rest program-args)
  ;; Just fire and forget to let things like browse-url work, not supporting the entire Process sub-system.
  (let [command (cons program program-args)]
    (future (apply sh/sh command))))

Replace the plist of PROCESS with PLIST. Returns PLIST.

(defun set-process-plist (process plist))

Interrupt process PROCESS. PROCESS may be a process, a buffer, or the name of a process or buffer. No arg or nil means current buffer's process. Second arg CURRENT-GROUP non-nil means send signal to the current process-group of the process's controlling terminal rather than to the process's own process group. If the process is a shell, this means interrupt current subjob rather than the shell.

If CURRENT-GROUP is `lambda', and if the shell owns the terminal, don't send the signal.

(defun interrupt-process (&optional process current-group))
 
(ns deuce.emacs.character
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

A char-table for characters which invoke auto-filling. Such characters have value t in this table.

(defvar auto-fill-chars nil)

A char-table for each printable character.

(defvar printable-chars nil)

Char table of Unicode's "General Category". All Unicode characters have one of the following values (symbol): Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po, Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn See The Unicode Standard for the meaning of those values.

(defvar unicode-category-table nil)

A char-table for width (columns) of each character.

(defvar char-width-table nil)

Char table of script symbols. It has one extra slot whose value is a list of script symbols.

(defvar char-script-table nil)

Vector recording all translation tables ever defined. Each element is a pair (SYMBOL . TABLE) relating the table to the symbol naming it. The ID of a translation table is an index into this vector.

(defvar translation-table-vector nil)

Alist of scripts vs the representative characters. Each element is a cons (SCRIPT . CHARS). SCRIPT is a symbol representing a script or a subgroup of a script. CHARS is a list or a vector of characters. If it is a list, all characters in the list are necessary for supporting SCRIPT. If it is a vector, one of the characters in the vector is necessary. This variable is used to find a font for a specific script.

(defvar script-representative-chars nil)

Convert the byte CH to multibyte character.

(defun unibyte-char-to-multibyte (ch))

Convert the multibyte character CH to a byte. If the multibyte character does not represent a byte, return -1.

(defun multibyte-char-to-unibyte (ch))

Resolve modifiers in the character CHAR. The value is a character with modifiers resolved into the character code. Unresolved modifiers are kept in the value.

(defun char-resolve-modifiers (char))

Return width of STRING when displayed in the current buffer. Width is measured by how many columns it occupies on the screen. When calculating width of a multibyte character in STRING, only the base leading-code is considered; the validity of the following bytes is not checked. Tabs in STRING are always taken to occupy `tab-width' columns.

(defun string-width (string)
  (count (.getBytes (str string))))

Return width of CHAR when displayed in the current buffer. The width is measured by how many columns it occupies on the screen. Tab is taken to occupy `tab-width' columns.

(defun char-width (char))
(declare max-char)

Return non-nil if OBJECT is a character.

(defun characterp (object)
  (and ((some-fn integer? char?) object) (pos? (int object)) (<= (int object) (max-char))))

Concatenate all the argument bytes and make the result a unibyte string.

(defun unibyte-string (&rest bytes)
  (String. (byte-array (map byte bytes)) "US-ASCII"))

Return a byte value of a character at point. Optional 1st arg POSITION, if non-nil, is a position of a character to get a byte value. Optional 2nd arg STRING, if non-nil, is a string of which first character is a target to get a byte value. In this case, POSITION, if non-nil, is an index of a target character in the string.

If the current buffer (or STRING) is multibyte, and the target character is not ASCII nor 8-bit character, an error is signaled.

(defun get-byte (&optional position string))

Return the character of the maximum code.

(defun max-char ()
  ;;0x3FFFFF in Emacs.
  (int Character/MAX_VALUE))
 
(ns deuce.emacs.xdisp
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.fileio :as fileio]
            [deuce.emacs.fns :as fns]
            [deuce.emacs.frame :as frame]
            [deuce.emacs.keyboard :as keyboard]
            [deuce.emacs.window :as window])
  (:import [deuce.emacs.data Buffer BufferText Frame])
  (:refer-clojure :exclude []))

*The number of lines to try scrolling a window by when point moves out. If that fails to bring point back on frame, point is centered instead. If this is zero, point is always centered after it moves off frame. If you want scrolling to always be a line at a time, you should set `scroll-conservatively' to a large value rather than set this to 1.

You can customize this variable.

(defvar scroll-step nil)

Non-nil means show an hourglass pointer, when Emacs is busy. This feature only works when on a window system that can change cursor shapes.

You can customize this variable.

(defvar display-hourglass nil)

Non-nil means don't actually do any redisplay. This is used for internal purposes.

(defvar inhibit-redisplay nil)

Non-nil means don't eval Lisp during redisplay.

(defvar inhibit-eval-during-redisplay nil)

Prefix prepended to all continuation lines at display time. The value may be a string, an image, or a stretch-glyph; it is interpreted in the same way as the value of a `display' text property.

This variable is overridden by any `wrap-prefix' text or overlay property.

To add a prefix to non-continuation lines, use `line-prefix'.

(defvar wrap-prefix nil)

*Non-nil means highlight trailing whitespace. The face used for trailing whitespace is `trailing-whitespace'.

You can customize this variable.

(defvar show-trailing-whitespace nil)

*The pointer shape to show in void text areas. A value of nil means to show the text pointer. Other options are `arrow', text',hand', vdrag',hdrag', modeline', andhourglass'.

(defvar void-text-area-pointer nil)

Alist specifying how to blink the cursor off. Each element has the form (ON-STATE . OFF-STATE). Whenever the `cursor-type' frame-parameter or variable equals ON-STATE, comparing using `equal', Emacs uses OFF-STATE to specify how to blink it off. ON-STATE and OFF-STATE are values for the `cursor-type' frame parameter.

If a frame's ON-STATE has no entry in this list, the frame's other specifications determine how to blink the cursor off.

You can customize this variable.

(defvar blink-cursor-alist nil)

Allow or disallow automatic horizontal scrolling of windows. If non-nil, windows are automatically scrolled horizontally to make point visible.

You can customize this variable.

(defvar auto-hscroll-mode nil)

Non-nil means don't free realized faces. Internal use only.

(defvar inhibit-free-realized-faces nil)

*Maximum buffer size for which line number should be displayed. If the buffer is bigger than this, the line number does not appear in the mode line. A value of nil means no limit.

You can customize this variable.

(defvar line-number-display-limit nil)

Normal hook run to update the menu bar definitions. Redisplay runs this hook before it redisplays the menu bar. This is used to update submenus such as Buffers, whose contents depend on various data.

(defvar menu-bar-update-hook nil)

Functions to call in redisplay when text in the window might change.

(defvar window-text-change-functions nil)

*Number of lines of margin at the top and bottom of a window. Recenter the window whenever point gets within this many lines of the top or bottom of the window.

You can customize this variable.

(defvar scroll-margin nil)

Maximum number of lines to keep in the message log buffer. If nil, disable message logging. If t, log messages but don't truncate the buffer when it becomes large.

You can customize this variable.

(defvar message-log-max nil)

*Border below tool-bar in pixels. If an integer, use it as the height of the border. If it is one of internal-border-width' orborder-width', use the value of the corresponding frame parameter. Otherwise, no border is added below the tool-bar.

(defvar tool-bar-border nil)

*How many columns away from the window edge point is allowed to get before automatic hscrolling will horizontally scroll the window.

You can customize this variable.

(defvar hscroll-margin nil)

*Scroll up to this many lines, to bring point back on screen. If point moves off-screen, redisplay will scroll by up to `scroll-conservatively' lines in order to bring point just barely onto the screen again. If that cannot be done, then redisplay recenters point as usual.

If the value is greater than 100, redisplay will never recenter point, but will always scroll just enough text to bring point into view, even if you move far away.

A value of zero means always recenter point if it moves off screen.

You can customize this variable.

(defvar scroll-conservatively nil)

*Non-nil means display unibyte text according to language environment. Specifically, this means that raw bytes in the range 160-255 decimal are displayed by converting them to the equivalent multibyte characters according to the current language environment. As a result, they are displayed according to the current fontset.

Note that this variable affects only how these bytes are displayed, but does not change the fact they are interpreted as raw bytes.

You can customize this variable.

(defvar unibyte-display-via-language-environment nil)

*Relief thickness of tool-bar buttons.

(defvar tool-bar-button-relief nil)

*Margin around tool-bar buttons in pixels. If an integer, use that for both horizontal and vertical margins. Otherwise, value should be a pair of integers `(HORZ . VERT)' with HORZ specifying the horizontal margin, and VERT specifying the vertical margin.

(defvar tool-bar-button-margin nil)

If non-nil, messages are truncated instead of resizing the echo area. Bind this around calls to `message' to let it take effect.

(defvar message-truncate-lines nil)

*Maximum number of characters a label can have to be shown. The tool bar style must also show labels for this to have any effect, see `tool-bar-style'.

You can customize this variable.

(defvar tool-bar-max-label-size nil)

Prefix prepended to all non-continuation lines at display time. The value may be a string, an image, or a stretch-glyph; it is interpreted in the same way as the value of a `display' text property.

This variable is overridden by any `line-prefix' text or overlay property.

To add a prefix to continuation lines, use `wrap-prefix'.

(defvar line-prefix nil)

Functions called when redisplay of a window reaches the end trigger. Each function is called with two arguments, the window and the end trigger value. See `set-window-redisplay-end-trigger'.

(defvar redisplay-end-trigger-functions nil)

*Maximum height for resizing mini-windows (the minibuffer and the echo area). If a float, it specifies a fraction of the mini-window frame's height. If an integer, it specifies a number of lines.

You can customize this variable.

(defvar max-mini-window-height nil)

Marker for where to display an arrow on top of the buffer text. This must be the beginning of a line in order to work. See also `overlay-arrow-string'.

(defvar overlay-arrow-position nil)

Template for displaying the title bar of an iconified frame. (Assuming the window manager supports this feature.) This variable has the same structure as `mode-line-format' (which see), and is used only on frames for which no explicit name has been set (see `modify-frame-parameters').

(defvar icon-title-format nil)

List of variables (symbols) which hold markers for overlay arrows. The symbols on this list are examined during redisplay to determine where to display overlay arrows.

(defvar overlay-arrow-variable-list nil)

Non-nil means truncate lines in windows narrower than the frame. For an integer value, truncate lines in each window narrower than the full frame width, provided the window width is less than that integer; otherwise, respect the value of `truncate-lines'.

For any other non-nil value, truncate lines in all windows that do not span the full frame width.

A value of nil means to respect the value of `truncate-lines'.

If `word-wrap' is enabled, you might want to reduce this.

You can customize this variable.

(defvar truncate-partial-width-windows nil)

*Non-nil means to scroll (recenter) cursor line if it is not fully visible.

(defvar make-cursor-line-fully-visible nil)

*Seconds to wait before displaying an hourglass pointer when Emacs is busy.

You can customize this variable.

(defvar hourglass-delay nil)

Non-nil means don't update menu bars. Internal use only.

(defvar inhibit-menubar-update nil)

Pixels per inch value for non-window system displays. Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI).

(defvar display-pixels-per-inch nil)

*Non-nil means raise tool-bar buttons when the mouse moves over them.

(defvar auto-raise-tool-bar-buttons nil)

Control highlighting of non-ASCII space and hyphen chars. If the value is t, Emacs highlights non-ASCII chars which have the same appearance as an ASCII space or hyphen, using the `nobreak-space' or `escape-glyph' face respectively.

U+00A0 (no-break space), U+00AD (soft hyphen), U+2010 (hyphen), and U+2011 (non-breaking hyphen) are affected.

Any other non-nil value means to display these characters as a escape glyph followed by an ordinary space or hyphen.

A value of nil means no special handling of these characters.

(defvar nobreak-char-display nil)

*Non-nil means automatically resize tool-bars. This dynamically changes the tool-bar's height to the minimum height that is needed to make all tool-bar items visible. If value is `grow-only', the tool-bar's height is only increased automatically; to decrease the tool-bar height, use M-x recenter.

(defvar auto-resize-tool-bars nil)

List of functions to call to fontify regions of text. Each function is called with one argument POS. Functions must fontify a region starting at POS in the current buffer, and give fontified regions the property `fontified'.

(defvar fontification-functions nil)

*How many columns to scroll the window when point gets too close to the edge. When point is less than `hscroll-margin' columns from the window edge, automatic hscrolling will scroll the window by the amount of columns determined by this variable. If its value is a positive integer, scroll that many columns. If it's a positive floating-point number, it specifies the fraction of the window's width to scroll. If it's nil or zero, point will be centered horizontally after the scroll. Any other value, including negative numbers, are treated as if the value were zero.

Automatic hscrolling always moves point outside the scroll margin, so if point was more than scroll step columns inside the margin, the window will scroll more than the value given by the scroll step.

Note that the lower bound for automatic hscrolling specified by `scroll-left' and `scroll-right' overrides this variable's effect.

You can customize this variable.

(defvar hscroll-step nil)

String to display as an arrow in non-window frames. See also `overlay-arrow-position'.

(defvar overlay-arrow-string nil)

List of functions to call before redisplaying a window with scrolling. Each function is called with two arguments, the window and its new display-start position. Note that these functions are also called by set-window-buffer'. Also note that the value ofwindow-end' is not valid when these functions are called.

Warning: Do not use this feature to alter the way the window is scrolled. It is not designed for that, and such use probably won't work.

(defvar window-scroll-functions nil)

Template for displaying the title bar of visible frames. (Assuming the window manager supports this feature.)

This variable has the same structure as `mode-line-format', except that the %c and %l constructs are ignored. It is used only on frames for which no explicit name has been set (see `modify-frame-parameters').

(defvar frame-title-format nil)

*Non-nil means autoselect window with mouse pointer. If nil, do not autoselect windows. A positive number means delay autoselection by that many seconds: a window is autoselected only after the mouse has remained in that window for the duration of the delay. A negative number has a similar effect, but causes windows to be autoselected only after the mouse has stopped moving. (Because of the way Emacs compares mouse events, you will occasionally wait twice that time before the window gets selected.) Any other value means to autoselect window instantaneously when the mouse pointer enters it.

Autoselection selects the minibuffer only if it is active, and never unselects the minibuffer if it is active.

When customizing this variable make sure that the actual value of `focus-follows-mouse' matches the behavior of your window manager.

You can customize this variable.

(defvar mouse-autoselect-window nil)

Functions called before redisplay, if window sizes have changed. The value should be a list of functions that take one argument. Just before redisplay, for each frame, if any of its windows have changed size since the last redisplay, or have been split or deleted, all the functions in the list are called, with the frame as argument.

(defvar window-size-change-functions nil)

Frame for which we are updating a menu. The enable predicate for a menu binding should check this variable.

(defvar menu-updating-frame nil)

Non-nil if more than one frame is visible on this display. Minibuffer-only frames don't count, but iconified frames do. This variable is not guaranteed to be accurate except while processing frame-title-format' andicon-title-format'.

(defvar multiple-frames nil)

When nil, display the mode-line/header-line/menu-bar in the default face. Any other value means to use the appropriate face, `mode-line', header-line', ormenu' respectively.

You can customize this variable.

(defvar mode-line-inverse-video nil)

Tool bar style to use. It can be one of image - show images only text - show text only both - show both, text below image both-horiz - show text to the right of the image text-image-horiz - show text to the left of the image any other - use system default or image if no system default.

You can customize this variable.

(defvar tool-bar-style nil)

How to resize mini-windows (the minibuffer and the echo area). A value of nil means don't automatically resize mini-windows. A value of t means resize them to fit the text displayed in them. A value of `grow-only', the default, means let mini-windows grow only; they return to their normal size when the minibuffer is closed, or the echo area becomes empty.

(defvar resize-mini-windows nil)

String (or mode line construct) included (normally) in `mode-line-format'.

(defvar global-mode-string nil)

*Maximum line width (in characters) for line number display. If the average length of the lines near point is bigger than this, then the line number may be omitted from the mode line.

You can customize this variable.

(defvar line-number-display-limit-width nil)

Minimum distance between baseline and underline. This can improve legibility of underlined text at small font sizes, particularly when using variable `x-use-underline-position-properties' with fonts that specify an UNDERLINE_POSITION relatively close to the baseline. The default value is 1.

You can customize this variable.

(defvar underline-minimum-offset nil)

Char-table defining glyphless characters. Each element, if non-nil, should be one of the following: an ASCII acronym string: display this string in a box `hex-code': display the hexadecimal code of a character in a box `empty-box': display as an empty box `thin-space': display as 1-pixel width space `zero-width': don't display An element may also be a cons cell (GRAPHICAL . TEXT), which specifies the display method for graphical terminals and text terminals respectively. GRAPHICAL and TEXT should each have one of the values listed above.

The char-table has one extra slot to control the display of a character for which no font is found. This slot only takes effect on graphical terminals. Its value should be an ASCII acronym string, hex-code',empty-box', or thin-space'. The default isempty-box'.

(defvar glyphless-char-display nil)

*Space between overline and text, in pixels. The default value is 2: the height of the overline (1 pixel) plus 1 pixel margin to the character height.

You can customize this variable.

(defvar overline-margin nil)

*Non-nil means highlight region even in nonselected windows.

You can customize this variable.

(defvar highlight-nonselected-windows nil)
(fns/put 'glyphless-char-display 'char-table-extra-slots 0)

Return paragraph direction at point in BUFFER. Value is either left-to-right' orright-to-left'. If BUFFER is omitted or nil, it defaults to the current buffer.

Paragraph direction determines how the text in the paragraph is displayed. In left-to-right paragraphs, text begins at the left margin of the window and the reading direction is generally left to right. In right-to-left paragraphs, text begins at the right margin and is read from right to left.

See also `bidi-paragraph-direction'.

(defun current-bidi-paragraph-direction (&optional buffer)
  'left-to-right)
(defn ^:private point-coords-for-buffer [buffer]
  (let [[px py] ((ns-resolve 'deuce.emacs.cmds 'point-coords) buffer)]
    [px (inc py)]))

Format a string out of a mode line format specification. First arg FORMAT specifies the mode line format (see `mode-line-format' for details) to use.

By default, the format is evaluated for the currently selected window.

Optional second arg FACE specifies the face property to put on all characters for which no face is specified. The value nil means the default face. The value t means whatever face the window's mode line currently uses (either mode-line' ormode-line-inactive', depending on whether the window is the selected window or not). An integer value means the value string has no text properties.

Optional third and fourth args WINDOW and BUFFER specify the window and buffer to use as the context for the formatting (defaults are the selected window and the WINDOW's buffer).

(defun format-mode-line (format &optional face window buffer)
  (let [window (el/check-type 'windowp (or window (window/selected-window)))
        buffer (el/check-type 'bufferp (or buffer (window/window-buffer window)))
        window-width (max (window/window-total-width window)
                          (data/symbol-value 'fill-column)) ;; Hack for stdout
        window-height (max (window/window-total-height window) 10)
        lines (count (filter #{\newline} (str (.beg ^BufferText (.text ^Buffer buffer)))))
        [column line] (point-coords-for-buffer buffer)
        all-visible? (> window-height lines)
        modified? (buffer/buffer-modified-p buffer)
        read-only? (buffer/buffer-local-value 'buffer-read-only buffer)
        recursion-depth (keyboard/recursion-depth)
        coding-system-mnemonic "1" ;; "1" is ISO-Latin-1, U" is UTF-8, "-" is ASCII. See interntional/mule-conf
        eol-type-mnemnonic ((el/fun 'coding-system-eol-type-mnemonic) nil)
        % (fn [x] (re-pattern (str "%(-?\\d*)" x)))
        humanize (fn [x]
                   (some identity (reverse
                          (map-indexed (fn [idx suffix]
                                         (let [size (Math/pow 1024 idx)]
                                           (when (> x size)
                                             (str (long (/ x size)) suffix))) )
                                       ["" "k" "M" "G"]))))
        pad (fn padder
              ([value] (partial padder value))
              ([value [_ pad]]
                 (let [s (str value)
                       pad (when (seq pad) (Integer/parseInt pad))]
                   (c/format (str "%" (if (or (not pad) (neg? pad)) ""
                                          (if (and (pos? pad) (number? value)) pad (- pad))) "s")
                             (if (and pad (neg? pad))
                               (subs s 0 (min (count s) (- pad)))
                               s)))))
        formatter (fn formatter [f] ;; Vastly incomplete and wrong.
                    (condp some [f]
                      string? (let [%% (str (gensym "PERCENT"))]
                                (-> ;; Deal with %% last.
                                 (reduce #(s/replace %1 (key %2) (val %2)) (s/replace f "%%" %%)
                                         {(% "e") (if (data/symbol-value 'memory-full) "!MEM FULL! " "")
                                          (% "n") "" ;; "Narrow"
                                          (% "z") coding-system-mnemonic
                                          (% "Z") (str coding-system-mnemonic eol-type-mnemnonic)
                                          (% "\\[") (if (< 5 recursion-depth)
                                                      "[[[... "
                                                      (s/join (repeat (keyboard/recursion-depth) "[" )))
                                          (% "\\]") (if (< 5 recursion-depth)
                                                      " ...]]]"
                                                      (s/join (repeat (keyboard/recursion-depth) "]" )))
                                          (% "@")  "-" ;; files/file-remote-p
                                          (% "\\+") (cond
                                                     modified? "*"
                                                     read-only? "%"
                                                     :else "-")
                                          (% "\\*") (cond
                                                     read-only? "%"
                                                     modified? "*"
                                                     :else "-")
                                          (% "&") (if modified? "*" "-")
                                          (% "l") (str line)
                                          (% "c") (str column)
                                          (% "i") (pad (editfns/buffer-size buffer)) ;; Should take narrowing in account.
                                          (% "I") (pad (humanize (editfns/buffer-size buffer)))
                                          (% "p") (pad (if all-visible?
                                                         "All"
                                                         (let [percent (long (* 100 (/ @(.pt ^Buffer buffer)
                                                                                       (inc (editfns/buffer-size buffer)))))]
                                                           (case percent
                                                             0 "Top"
                                                             100 "Bottom"
                                                             (str percent "%")))))
                                          ;; (% "P") ;; The reverse of the above
                                          (% "m") (pad (buffer/buffer-local-value 'mode-name buffer))
                                          (% "M") (pad (data/symbol-value 'global-mode-string))
                                          (% "b") (pad (buffer/buffer-name buffer))
                                          (% "f") (pad (buffer/buffer-file-name buffer))
                                          (% "F") (pad (.name ^Frame (frame/selected-frame)))})
                                 (s/replace %% "%")))
                      symbol? (formatter (data/symbol-value f))
                      seq? (let [fst (first f)]
                             (condp some [fst]
                               integer? (pad (formatter (rest f)) [:ignored (str fst)])
                               #{:eval} (formatter (eval/eval (second f)))
                               #{:propertize} (formatter (second f)) ;; Properties are used for tooltips, fonts etc.
                               symbol? (if (and (data/boundp fst) (data/symbol-value fst))
                                         (formatter (second f))
                                         (formatter (nth f 2 nil)))
                               (s/join (map formatter f))))
                      (str f)))]
    (let [mode-line (formatter format)]
      (s/replace mode-line #"%-$"
                 (s/join (repeat (+ (- window-width (count mode-line)) (count "%-")) "-"))))))

Non-nil if the property makes the text invisible. POS-OR-PROP can be a marker or number, in which case it is taken to be a position in the current buffer and the value of the `invisible' property is checked; or it can be some other value, which is then presumed to be the value of the `invisible' property of the text of interest. The non-nil value returned can be t for truly invisible text or something else if the text is replaced by an ellipsis.

(defun invisible-p (pos-or-prop))
 
(ns deuce.emacs.eval
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.data :as data]
            [deuce.emacs-lisp.cons :as cons]
            [deuce.emacs-lisp :as el])
  (:import [clojure.lang Var])
  (:refer-clojure :exclude [apply eval macroexpand]))

Function to call to invoke debugger. If due to frame exit, args are `exit' and the value being returned; this function's value will be returned instead of that. If due to error, args are error' and a list of the args tosignal'. If due to apply' orfuncall' entry, one arg, `lambda'. If due to `eval' entry, one arg, t.

(defvar debugger nil)

Non-nil inhibits C-g quitting from happening immediately. Note that `quit-flag' will still be set by typing C-g, so a quit will be signaled as soon as `inhibit-quit' is nil. To prevent this happening, set `quit-flag' to nil before making `inhibit-quit' nil.

(defvar inhibit-quit nil)

*Limit on depth in eval',apply' and `funcall' before error.

This limit serves to catch infinite recursions for you before they cause actual stack overflow in C, which would be fatal for Emacs. You can safely make it considerably larger than its default value, if that proves inconveniently small. However, if you increase it too far, Emacs could overflow the real C stack, and crash.

You can customize this variable.

(defvar max-lisp-eval-depth nil)

Function to process declarations in a macro definition. The function will be called with two args MACRO and DECL. MACRO is the name of the macro being defined. DECL is a list `(declare ...)' containing the declarations. The value the function returns is not used.

(defvar macro-declaration-function nil)

Non-nil causes eval' to abort, unlessinhibit-quit' is non-nil. If the value is t, that means do an ordinary quit. If the value equals `throw-on-input', that means quit by throwing to the tag specified in throw-on-input'; it's for handlingwhile-no-input'. Typing C-g sets quit-flag' to t, regardless ofinhibit-quit', but `inhibit-quit' non-nil prevents anything from taking notice of that.

(defvar quit-flag nil)

*Non-nil means call the debugger regardless of condition handlers. Note that debug-on-error',debug-on-quit' and friends still determine whether to handle the particular condition.

(defvar debug-on-signal nil)

If non-nil, this is a function for `signal' to call. It receives the same arguments that `signal' was given. The Edebug package uses this to regain control.

(defvar signal-hook-function nil)

Non-nil means enter debugger before next eval',apply' or `funcall'.

(defvar debug-on-next-call nil)

*List of errors for which the debugger should not be called. Each element may be a condition-name or a regexp that matches error messages. If any element applies to a given error, that error skips the debugger and just returns to top level. This overrides the variable `debug-on-error'. It does not apply to errors handled by `condition-case'.

You can customize this variable.

(defvar debug-ignored-errors nil)

*Non-nil means enter debugger if quit is signaled (C-g, for example). Does not apply if quit is handled by a `condition-case'.

You can customize this variable.

(defvar debug-on-quit nil)

*Non-nil means enter debugger if an error is signaled. Does not apply to errors handled by `condition-case' or those matched by `debug-ignored-errors'. If the value is a list, an error only means to enter the debugger if one of its condition symbols appears in the list. When you evaluate an expression interactively, this variable is temporarily non-nil if `eval-expression-debug-on-error' is non-nil. The command `toggle-debug-on-error' toggles this. See also the variable `debug-on-quit'.

You can customize this variable.

(defvar debug-on-error nil)

Non-nil means debugger may continue execution. This is nil when the debugger is called under circumstances where it might not be safe to continue.

(defvar debugger-may-continue nil)

*Limit on number of Lisp variable bindings and `unwind-protect's. If Lisp code tries to increase the total number past this amount, an error is signaled. You can safely use a value considerably larger than the default value, if that proves inconveniently small. However, if you increase it too far, Emacs could run out of memory trying to make the stack bigger.

You can customize this variable.

(defvar max-specpdl-size nil)
(declare apply eval funcall)

Return t if VARIABLE is intended to be set and modified by users. (The alternative is a variable used internally in a Lisp program.)

This function returns t if (i) the first character of its documentation is `*', or (ii) it is customizable (its property list contains a non-nil value of standard-value' orcustom-autoload'), or (iii) it is an alias for a user variable.

But condition (i) is considered obsolete, so for most purposes this is equivalent to `custom-variable-p'.

(defun user-variable-p (variable))

Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a context where binding is lexical by default.

(defun special-variable-p (symbol))

Non-nil if OBJECT is a function.

(defun functionp (object)
  (when (or (fn? object)
            (and (symbol? object) (el/fun object))
            (and (seq? object) (= 'lambda (first object))))
    true))

Define FUNCTION to autoload from FILE. FUNCTION is a symbol; FILE is a file name string to pass to `load'. Third arg DOCSTRING is documentation for the function. Fourth arg INTERACTIVE if non-nil says function can be called interactively. Fifth arg TYPE indicates the type of the object: nil or omitted says FUNCTION is a function, `keymap' says FUNCTION is really a keymap, and `macro' or t says FUNCTION is really a macro. Third through fifth args give info about the real definition. They default to nil. If FUNCTION is already defined other than as an autoload, this does nothing and returns nil.

(defun autoload (function file &optional docstring interactive type)
  (when (or (not (el/fun function)) (-> (el/fun function) meta :autoload))
    (let [macro? (= 'macro type)
          autoload-symbol (fn autoload-symbol [function]
                            (let [f (el/fun function)]
                              (when (-> f meta :autoload)
                                (ns-unmap 'deuce.emacs (el/sym function))
                                ((el/fun 'load) (-> f meta :file) nil true))))
          definition  (if macro?
                        (fn autoload-macro [&form &env & args] ;; Note implicit macro args, see defalias
                          (do
                            (autoload-symbol function)
                            `(el/progn (~(el/sym function) ~@args))))
                        (fn autoload [& args]
                          (autoload-symbol function)
                          (c/apply (el/fun function) args)))] ;; el->clj?
      (ns-unmap 'deuce.emacs function)
      (el/defvar-helper* 'deuce.emacs function definition docstring)
      (alter-meta! (el/fun function) merge {:autoload true :file file} (when interactive {:interactive nil}))
      (when macro? (.setMacro ^Var (el/fun function))))
    function))

If byte-compiled OBJECT is lazy-loaded, fetch it now.

(defun fetch-bytecode (object))

Signal an error. Args are ERROR-SYMBOL and associated DATA. This function does not return.

An error symbol is a symbol with an `error-conditions' property that is a list of condition names. A handler for any of those names will get to handle this signal. The symbol `error' should normally be one of them.

DATA should be a list. Its elements are printed as part of the error message. See Info anchor `(elisp)Definition of signal' for some details on how this error message is constructed. If the signal is handled, DATA is made available to the handler. See also the function `condition-case'.

(defun signal (error-symbol data)
  (el/throw error-symbol data))

Return t if the containing function was called by `call-interactively'. If KIND is `interactive', then only return t if the call was made interactively by the user, i.e. not in `noninteractive' mode nor when `executing-kbd-macro'. If KIND is `any', on the other hand, it will return t for any kind of interactive call, including being called as the binding of a key, or from a keyboard macro, or in `noninteractive' mode.

The only known proper use of `interactive' for KIND is in deciding whether to display a helpful message, or how to display it. If you're thinking of using it for any other purpose, it is quite likely that you're making a mistake. Think: what do you want to do when the command is called from a keyboard macro?

Instead of using this function, it is sometimes cleaner to give your function an extra optional argument whose `interactive' spec specifies non-nil unconditionally ("p" is a good way to do this), or via (not (or executing-kbd-macro noninteractive)).

(defun called-interactively-p (kind)
  nil)

Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with the given arguments and its return value is returned. If it is a list of functions, those functions are called, in order, with the given arguments ARGS. It is best not to depend on the value returned by `run-hook-with-args', as that may change.

Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument.

(defun run-hook-with-args (hook &rest args)
  (when-let [hook (el/global hook)]
    (let [hook @hook]
      (doall (map #(c/apply funcall % args) (if (fn? hook) [hook] hook))))))

Call first argument as a function, passing remaining arguments to it. Return the value that function returns. Thus, (funcall 'cons 'x 'y) returns (x . y).

(defun funcall (function &rest arguments)
  (apply function arguments))

Run HOOK, passing each function through WRAP-FUNCTION. I.e. instead of calling each function FUN directly with arguments ARGS, it calls WRAP-FUNCTION with arguments FUN and ARGS. As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped' aborts and returns that value.

(defun run-hook-wrapped (hook wrap-function &rest args))

This function is obsolete since 23.2; use `called-interactively-p' instead.

Return t if the containing function was run directly by user input. This means that the function was called with `call-interactively' (which includes being called as the binding of a key) and input is currently coming from the keyboard (not a keyboard macro), and Emacs is not running in batch mode (`noninteractive' is nil).

The only known proper use of `interactive-p' is in deciding whether to display a helpful message, or how to display it. If you're thinking of using it for any other purpose, it is quite likely that you're making a mistake. Think: what do you want to do when the command is called from a keyboard macro?

To test whether your function was called with `call-interactively', either (i) add an extra optional argument and give it an `interactive' spec that specifies non-nil unconditionally (such as "p"); or (ii) use `called-interactively-p'.

(defun interactive-p ())

Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. Aliased variables always have the same value; setting one sets the other. Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE, or of the variable at the end of the chain of aliases, if BASE-VARIABLE is itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, then the value of BASE-VARIABLE is set to that of NEW-ALIAS. The return value is BASE-VARIABLE.

(defun defvaralias (new-alias base-variable &optional docstring)
  (if-let [base (el/global base-variable)]
    (el/defvar-helper* 'deuce.emacs-lisp.globals new-alias
      @base (or docstring (-> base meta :doc)))
    (when-let [new (el/global new-alias)]
      (el/defvar-helper* 'deuce.emacs-lisp.globals base-variable
        @new (or docstring (-> new meta :doc)))))
  base-variable)

Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with the given arguments and its return value is returned. If it is a list of functions, those functions are called, in order, with the given arguments ARGS, until one of them returns a non-nil value. Then we return that value. However, if they all return nil, we return nil.

Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument.

(defun run-hook-with-args-until-success (hook &rest args)
  (some identity (apply run-hook-with-args hook args)))

Print a trace of Lisp function calls currently active. Output stream used is value of `standard-output'.

(defun backtrace ()
  (interactive))

Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with the given arguments and its return value is returned. If it is a list of functions, those functions are called, in order, with the given arguments ARGS, until one of them returns nil. Then we return nil. However, if they all return non-nil, we return non-nil.

Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument.

(defun run-hook-with-args-until-failure (hook &rest args)
  (or (some (complement identity) (apply run-hook-with-args hook args))
      true))

Call FUNCTION with our remaining args, using our last arg as list of args. Then return the value FUNCTION returns. Thus, (apply '+ 1 2 '(3 4)) returns 10.

(defun apply (function &rest arguments)
  (let [rest (last arguments)]
    (el/check-type 'listp rest)
    (c/apply (cond (symbol? function) (data/symbol-function function)
                   (data/listp function) (eval function)
                   :else function) (c/apply alloc/list (concat (butlast arguments) rest)))))

Run each hook in HOOKS. Each argument should be a symbol, a hook variable. These symbols are processed in the order specified. If a hook symbol has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with no arguments. If it is a list, the elements are called, in order, with no arguments.

Major modes should not use this function directly to run their mode hook; they should use `run-mode-hooks' instead.

Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument.

(defun run-hooks (&rest hooks)
  (doseq [hook hooks]
    (run-hook-with-args hook)))

Evaluate FORM and return its value. If LEXICAL is t, evaluate using lexical scoping.

(defun eval (form &optional lexical)
  (el/eval form lexical))

Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil.

(defun backtrace-debug (level flag))

Return the function and arguments NFRAMES up from current execution point. If that frame has not evaluated the arguments yet (or is a special form), the value is (nil FUNCTION ARG-FORMS...). If that frame has evaluated its arguments and called its function already, the value is (t FUNCTION ARG-VALUES...). A &rest arg is represented as the tail of the list ARG-VALUES. FUNCTION is whatever was supplied as car of evaluated list, or a lambda expression for macro calls. If NFRAMES is more than the number of frames, the value is nil.

(defun backtrace-frame (nframes))

Non-nil if FUNCTION makes provisions for interactive calling. This means it contains a description for how to read arguments to give it. The value is nil for an invalid function or a symbol with no function definition.

Interactively callable functions include strings and vectors (treated as keyboard macros), lambda-expressions that contain a top-level call to interactive', autoload definitions made byautoload' with non-nil fourth argument, and some of the built-in functions of Lisp.

Also, a symbol satisfies `commandp' if its function definition does so.

If the optional argument FOR-CALL-INTERACTIVELY is non-nil, then strings and vectors are not accepted.

(defun commandp (function &optional for-call-interactively)
  (if (or (data/stringp function) (data/vectorp function))
    (when-not for-call-interactively true)
    (when-let [f (el/fun function)]
      (when (contains? (meta f) :interactive)
        true))))

Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. Otherwise, the macro is expanded and the expansion is considered in place of FORM. When a non-macro-call results, it is returned.

The second optional arg ENVIRONMENT specifies an environment of macro definitions to shadow the loaded ones for use in file byte-compilation.

(defun macroexpand (form &optional environment)
  ;; Not sure how this is supposed to work even after reading eval.c, attempts to mimic observed behavior.
  ;; It is used in conjunction with cl-macroexpand-all, and should not expand into "raw" Clojure.
  (let [shadow (into {} (map #(vector (data/car %) (data/cdr %)) environment))
        shadow #(shadow % (shadow (str %)))
        unshadowed-form ((fn shadow-walker [form]
                           (if-let [expander (shadow form)]
                             (if (= '(true) (data/cdr-safe expander))
                               (cons (first (data/car expander))
                                     (map #(list 'quote %) (rest (data/car expander))))
                               (expander form))
                             (if (and (seq? form)
                                      (not= 'quote (first form)))
                               (cons/maybe-seq (map shadow-walker form))
                               form))) form)
        expansion (if-let [m  (and (seq? form) (-> (el/fun (first form)) meta))]
                    (if (and (:macro m) (= (the-ns 'deuce.emacs-lisp) (:ns m)))
                      unshadowed-form
                      (macroexpand-1 unshadowed-form))
                    unshadowed-form)]
    ;; Protect against eq check in cl-macroexpand-all
    (if (= form expansion)
      form
      expansion)))
 
(ns deuce.emacs.cmds
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.indent :as indent])
  (:import [java.util Arrays]
           [deuce.emacs.data Buffer BufferText])
  (:refer-clojure :exclude []))

Hook run at the end of `self-insert-command'. This is run after inserting the character.

(defvar post-self-insert-hook nil)
(defn ^:private line-indexes [s]
  (loop [idx 0 acc [0]]
    (let [idx (.indexOf (str s) (int \newline) idx)]
      (if (>= idx 0)
        (recur (inc idx) (conj acc (inc idx)))
        (int-array acc)))))
(defn ^:private pos-to-line [line-indexes pos]
  (let [pos (Arrays/binarySearch ^ints line-indexes (int pos))]
    (if (neg? pos) (- (- pos) 2) pos)))
(defn ^:private point-coords
  ([^Buffer buffer] (point-coords (line-indexes (str (.beg ^BufferText (.text buffer)))) (dec @(.pt buffer))))
  ([line-indexes offset]
      (let [pos-to-line (partial pos-to-line line-indexes)
            line (max (pos-to-line offset) 0)
            col (- offset (aget ^ints line-indexes line))]
        [col line])))

Now I've seen some convoluted Clojure in my days... Emacs "remembers" how long the line you started from and tries to "regain" that column when moving around. With some luck this is taken care of by some Emacs Lisp somewhere (right..).

(defn ^:private move-lines [s offset lines]
  (let [line-indexes (line-indexes s)
        [col line] (point-coords line-indexes offset)
        offset-of-line #(cond
                         (>= % (count line-indexes)) (count s)
                         (neg? %) 0
                         :else (aget ^ints line-indexes %))
        new-line (+ line lines)
        line-offset (offset-of-line new-line)
        empty-line? (zero? (- (offset-of-line (inc new-line)) line-offset))
        new-offset (cond
                    (neg? new-line) 0
                    empty-line? (inc line-offset)
                    :else (min (+ line-offset col)
                               (dec (offset-of-line (inc new-line)))))]
    (editfns/goto-char (inc new-offset))
    (cond
     (< (count line-indexes) new-line) (- new-line (count line-indexes))
     (neg? new-line) new-line
     :else 0)))
(declare forward-char)

Move N lines forward (backward if N is negative). Precisely, if point is on line I, move to the start of line I + N ("start of line" in the logical order). If there isn't room, go as far as possible (no error). Returns the count of lines left to move. If moving forward, that is N - number of lines moved; if backward, N + number moved. With positive N, a non-empty line at the end counts as one line successfully moved (for the return value).

(defun forward-line (&optional n)
  (interactive "^p")
  (move-lines (editfns/buffer-string) (dec (editfns/point))
              (el/check-type 'integerp (or n 1))))

Move point N characters forward (backward if N is negative). On reaching end or beginning of buffer, stop and signal error.

Depending on the bidirectional context, the movement may be to the right or to the left on the screen. This is in contrast with , which see.

(defun forward-char (&optional n)
  (interactive "^p")
  (editfns/goto-char (+ (editfns/point) (el/check-type 'integerp (or n 1)))))

This function is obsolete since 23.1; use (+ (point) N) instead.

Return buffer position N characters after (before if N negative) point.

(defun forward-point (n)
  (+ (editfns/point) n))

Insert the character you type. Whichever character you type to run this command is inserted. Before insertion, `expand-abbrev' is executed if the inserted character does not have word syntax and the previous character in the buffer does. After insertion, the value of `auto-fill-function' is called if the `auto-fill-chars' table has a non-nil value for the inserted character. At the end, it runs `post-self-insert-hook'.

(defun self-insert-command (n)
  (interactive "p")
  (editfns/insert (apply str (repeat n (char (data/symbol-value 'last-command-event)))))
  (eval/run-hooks 'post-self-insert-hook))

Move point N characters backward (forward if N is negative). On attempt to pass beginning or end of buffer, stop and signal error.

Depending on the bidirectional context, the movement may be to the right or to the left on the screen. This is in contrast with , which see.

(defun backward-char (&optional n)
  (interactive "^p")
  (editfns/goto-char (- (editfns/point) (el/check-type 'integerp (or n 1)))))

Move point to beginning of current line (in the logical order). With argument N not nil or 1, move forward N - 1 lines first. If point reaches the beginning or end of buffer, it stops there.

This function constrains point to the current field unless this moves point to a different line than the original, unconstrained result. If N is nil or 1, and a front-sticky field starts at point, the point does not move. To ignore field boundaries bind inhibit-field-text-motion' to t, or use theforward-line' function instead. For instance, `(forward-line 0)' does the same thing as `(beginning-of-line)', except that it ignores field boundaries.

(defun beginning-of-line (&optional n)
  (interactive "^p")
  (when-not (contains? #{nil 1} n)
    (forward-line n))
  (let [bol (.lastIndexOf (str (editfns/buffer-substring 1 (editfns/point))) (int \newline))]
    (if (= -1 bol)
      (editfns/goto-char 1)
      (editfns/goto-char (+ bol 2)))))

Delete the following N characters (previous if N is negative). Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). Interactively, N is the prefix arg, and KILLFLAG is set if N was explicitly specified.

The command `delete-forward-char' is preferable for interactive use.

(defun delete-char (n &optional killflag)
  (interactive "p\nP")
  (apply editfns/delete-region (sort [(editfns/point) (min (+ (editfns/point) n) 1)])))

Move point to end of current line (in the logical order). With argument N not nil or 1, move forward N - 1 lines first. If point reaches the beginning or end of buffer, it stops there. To ignore intangibility, bind `inhibit-point-motion-hooks' to t.

This function constrains point to the current field unless this moves point to a different line than the original, unconstrained result. If N is nil or 1, and a rear-sticky field ends at point, the point does not move. To ignore field boundaries bind `inhibit-field-text-motion' to t.

(defun end-of-line (&optional n)
  (interactive "^p")
  (when-not (contains? #{nil 1} n)
    (forward-line n))
  (let [eol (.indexOf (str (editfns/buffer-string)) (int \newline) (int (dec (editfns/point))))]
    (if (= -1 eol)
      (editfns/goto-char (editfns/point-max))
      (editfns/goto-char (inc eol)))))
 
(ns deuce.emacs.dispnew
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.frame :as frame]
            [deuce.emacs-lisp.parser :as parser])
  (:refer-clojure :exclude []))

Non-nil means no need to redraw entire frame after suspending. A non-nil value is useful if the terminal can automatically preserve Emacs's frame display when you reenter Emacs. It is up to you to set this variable if your terminal can do that.

You can customize this variable.

(defvar no-redraw-on-reenter nil)

Non-nil means put cursor in minibuffer, at end of any message there.

(defvar cursor-in-echo-area nil)

Display table to use for buffers that specify none. See `buffer-display-table' for more information.

(defvar standard-display-table nil)

Non-nil means try to flash the frame to represent a bell.

See also `ring-bell-function'.

You can customize this variable.

(defvar visible-bell nil)

Non-nil means display update isn't paused when input is detected.

(defvar redisplay-dont-pause nil)

Period in seconds between checking for input during redisplay. This has an effect only if `redisplay-dont-pause' is nil; in that case, arriving input preempts redisplay until the input is processed. If the value is nil, redisplay is never preempted.

(defvar redisplay-preemption-period nil)

The version number of the window system in use. For X windows, this is 11.

(defvar window-system-version nil)

Name of the window system that Emacs uses for the first frame. The value is a symbol: nil for a termcap frame (a character-only terminal), 'x' for an Emacs frame that is really an X window, 'w32' for an Emacs frame that is a window on MS-Windows display, 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 'pc' for a direct-write MS-DOS frame.

Use of this variable as a boolean is deprecated. Instead, use display-graphic-p' or any of the otherdisplay-*-p' predicates which report frame's specific UI-related capabilities.

(defvar initial-window-system nil)

The output baud rate of the terminal. On most systems, changing this value will affect the amount of padding and the other strategic decisions made during redisplay.

You can customize this variable.

(defvar baud-rate nil)

Table defining how to output a glyph code to the frame. If not nil, this is a vector indexed by glyph code to define the glyph. Each element can be: integer: a glyph code which this glyph is an alias for. string: output this glyph using that string (not impl. in X windows). nil: this glyph mod 524288 is the code of a character to output, and this glyph / 524288 is the face number (see `face-id') to use while outputting it.

(defvar glyph-table nil)

Non-nil means invert the entire frame display. This means everything is in inverse video which otherwise would not be.

You can customize this variable.

(defvar inverse-video nil)

Start writing all terminal output to FILE as well as the terminal. FILE = nil means just close any termscript file currently open.

(defun open-termscript (file)
  (interactive "FOpen termscript file: "))

Beep, or flash the screen. Also, unless an argument is given, terminate any keyboard macro currently executing.

(defun ding (&optional arg))

Set the cursor-visibility flag of WINDOW to SHOW. WINDOW nil means use the selected window. SHOW non-nil means show a cursor in WINDOW in the next redisplay. SHOW nil means don't show a cursor.

(defun internal-show-cursor (window show))

Clear frame FRAME and output again what is supposed to appear on it.

(defun redraw-frame (frame))

Return non-nil if the frame and buffer state appears to have changed. VARIABLE is a variable name whose value is either nil or a state vector that will be updated to contain all frames and buffers, aside from buffers whose names start with space, along with the buffers' read-only and modified flags. This allows a fast check to see whether buffer menus might need to be recomputed. If this function returns non-nil, it updates the internal vector to reflect the current state.

If VARIABLE is nil, an internal variable is used. Users should not pass nil for VARIABLE.

(defun frame-or-buffer-changed-p (&optional variable))

Perform redisplay. Optional arg FORCE, if non-nil, prevents redisplay from being preempted by arriving input, even if `redisplay-dont-pause' is nil. If `redisplay-dont-pause' is non-nil (the default), redisplay is never preempted by arriving input, so FORCE does nothing.

Return t if redisplay was performed, nil if redisplay was preempted immediately by pending input.

(defun redisplay (&optional force))

Value is non-nil if next redisplay will display a cursor in WINDOW. WINDOW nil or omitted means report on the selected window.

(defun internal-show-cursor-p (&optional window))

Value is last nonminibuffer frame.

(defun last-nonminibuffer-frame ()
  (frame/selected-frame))

Send STRING to the terminal without alteration. Control characters in STRING will have terminal-dependent effects.

Optional parameter TERMINAL specifies the tty terminal device to use. It may be a terminal object, a frame, or nil for the terminal used by the currently selected frame. In batch mode, STRING is sent to stdout when TERMINAL is nil.

(defun send-string-to-terminal (string &optional terminal)
  (.print System/out (parser/resolve-control-chars string))
  (.flush System/out))

Clear and redisplay all visible frames.

(defun redraw-display ()
  (interactive))

Pause, without updating display, for SECONDS seconds. SECONDS may be a floating-point value, meaning that you can wait for a fraction of a second. Optional second arg MILLISECONDS specifies an additional wait period, in milliseconds; this may be useful if your Emacs was built without floating point support. (Not all operating systems support waiting for a fraction of a second.)

(defun sleep-for (seconds &optional milliseconds)
  (Thread/sleep (+ (* 1000 seconds) (or milliseconds) 0)))
 
(ns deuce.emacs.keymap
  (:use [deuce.emacs-lisp :only (defun defvar setq) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [clojure.walk :as w]
            [deuce.emacs-lisp.cons :as cons]
            [deuce.emacs-lisp.globals :as globals]
            [deuce.emacs-lisp.parser :as parser]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.chartab :as chartab]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.fns :as fns]
            [deuce.emacs.textprop :as textprop])
  (:import [deuce.emacs.data CharTable])
  (:refer-clojure :exclude []))

List of keymap alists to use for emulations modes. It is intended for modes or packages using multiple minor-mode keymaps. Each element is a keymap alist just like `minor-mode-map-alist', or a symbol with a variable binding which is a keymap alist, and it is used the same way. The "active" keymaps in each alist are used before minor-mode-map-alist' andminor-mode-overriding-map-alist'.

(defvar emulation-mode-map-alists nil)

Local keymap for the minibuffer when spaces are not allowed.

(defvar minibuffer-local-ns-map nil)

Preferred modifier key to use for `where-is'. When a single binding is requested, `where-is' will return one that uses this modifier key if possible. If nil, or if no such binding exists, bindings using keys without modifiers (or only with meta) will be preferred.

(defvar where-is-preferred-modifier nil)

Alist of keymaps to use for minor modes, in current major mode. This variable is an alist just like `minor-mode-map-alist', and it is used the same way (and before `minor-mode-map-alist'); however, it is provided for major modes to bind locally.

(defvar minor-mode-overriding-map-alist nil)

Alist of keymaps to use for minor modes. Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read key sequences and look up bindings if VARIABLE's value is non-nil. If two active keymaps bind the same key, the keymap appearing earlier in the list takes precedence.

(defvar minor-mode-map-alist nil)

List of commands given new key bindings recently. This is used for internal purposes during Emacs startup; don't alter it yourself.

(defvar define-key-rebound-commands true)

Default keymap to use when reading from the minibuffer.

(defvar minibuffer-local-map nil)
(fns/put 'key-map 'char-table-extra-slots 0)
(def ^:private ^:dynamic *current-global-map* (atom nil))
(declare current-global-map current-minor-mode-maps keymapp keymap-parent set-keymap-parent lookup-key)

Construct and return a new sparse keymap. Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION), which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION), which binds the function key or mouse event SYMBOL to DEFINITION. Initially the alist is nil.

The optional arg STRING supplies a menu name for the keymap in case you use it as a menu with `x-popup-menu'.

(defun make-sparse-keymap (&optional string)
  (if string
    (alloc/list 'keymap string)
    (alloc/list 'keymap)))
(defn ^:private binding-this-map [keymap key]
  (let [char-table (second keymap)
        alist (if (data/char-table-p char-table) (fns/nthcdr 2 keymap) (data/cdr keymap))]
    (if (and (data/char-table-p (second keymap))
             (data/numberp key)
             (< (int key) (fns/length (second keymap))))
      (data/aref char-table key)
      (data/cdr (fns/assoc key alist)))))
(defn ^:private define-key-this-map [keymap key def]
  (let [char-table (second keymap)
        alist (if (data/char-table-p char-table) (fns/nthcdr 2 keymap) (data/cdr keymap))]
    (if (and (data/char-table-p char-table)
             (data/numberp key)
             (< (int key) (fns/length char-table)))
      (data/aset char-table key def)
      (if-let [existing (fns/assoc key alist)]
        (data/setcdr existing def)
        (data/setcdr (if (data/char-table-p char-table) (data/cdr keymap) keymap)
                     (alloc/cons (alloc/cons key def) alist))))))
(defn ^:private resolve-def [def]
  (cond (data/symbolp def)
   (try
     (let [maybe-keymap (data/symbol-function def)]
       (if (keymapp maybe-keymap)
         maybe-keymap
         def))
     (catch RuntimeException _
       def))
   (and (data/consp def)
        (string? (first def)))
   (data/cdr def)
   (and (data/consp def)
        (keymapp (first def)))
   (lookup-key (data/car def) (data/cdr def))
   :else def))
(defn ^:private binding-map [keymap key]
  (let [submap-or-binding (resolve-def (binding-this-map keymap (first key)))]
    (if-let [key (next key)]
      (if (keymapp submap-or-binding)
        (recur submap-or-binding key)
        (count key))
      submap-or-binding)))
(defn ^:private define-key-internal [keymap key def]
  (let [submap-or-binding (resolve-def (binding-this-map keymap (first key)))
        submap-or-binding (if-not submap-or-binding
                            (let [def (if (next key) (make-sparse-keymap) def)]
                              (define-key-this-map keymap
                                (first key) def)
                              def)
                            submap-or-binding)]
    (if-let [key (next key)]
      (if (keymapp submap-or-binding)
        (recur submap-or-binding key def)
        (throw (IllegalArgumentException.)))
      (define-key-this-map keymap (first key) def))))

In KEYMAP, define key sequence KEY as DEF. KEYMAP is a keymap.

KEY is a string or a vector of symbols and characters, representing a sequence of keystrokes and events. Non-ASCII characters with codes above 127 (such as ISO Latin-1) can be represented by vectors. Two types of vector have special meanings: [remap COMMAND] remaps any key binding for COMMAND. [t] creates a default definition, which applies to any event with no other definition in KEYMAP.

DEF is anything that can be a key's definition: nil (means key is undefined in this keymap), a command (a Lisp function suitable for interactive calling), a string (treated as a keyboard macro), a keymap (to define a prefix key), a symbol (when the key is looked up, the symbol will stand for its function definition, which should at that time be one of the above, or another symbol whose function definition is used, etc.), a cons (STRING . DEFN), meaning that DEFN is the definition (DEFN should be a valid definition in its own right), or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, or an extended menu item definition. (See info node `(elisp)Extended Menu Items'.)

If KEYMAP is a sparse keymap with a binding for KEY, the existing binding is altered. If there is no binding for KEY, the new pair binding KEY to DEF is added at the front of KEYMAP.

(defun define-key (keymap key def)
  (let [real-key key
        key (if (string? key)
              (parser/parse-characters key (data/symbol-value 'meta-prefix-char))
              (el/check-type 'arrayp key))
        keymap (if (data/symbolp keymap) (data/symbol-value keymap) keymap)]
    (try
      (define-key-internal keymap key def)
      (catch IllegalArgumentException e
        (el/throw* 'error (format "Key sequence %s starts with non-prefix key %s"
                                  (s/join " " key) (s/join " " (butlast key))))))
    def))

Return a copy of the keymap KEYMAP. The copy starts out with the same definitions of KEYMAP, but changing either the copy or KEYMAP does not affect the other. Any key definitions that are subkeymaps are recursively copied. However, a key definition which is a symbol whose definition is a keymap is not copied.

(defun copy-keymap (keymap)
  (el/check-type 'keymapp keymap)
  (letfn [(copy [x]
            (condp some [x]
              keymapp (copy-keymap x)
              seq? (cons/maybe-seq (map copy x))
              data/char-table-p (let [x ^CharTable x]
                                  (CharTable. (.defalt x)
                                              (atom @(.parent x))
                                              (.purpose x)
                                              (let [contents (object-array (count (.contents x)))]
                                                (System/arraycopy (.contents x) 0  contents 0 (count (.contents x)))
                                                contents)
                                              (object-array (.extras x))))
              x))]
    (let [parent (keymap-parent keymap)
          keymap (apply alloc/list keymap)]
      (set-keymap-parent keymap nil)
      (doto (cons/maybe-seq (map copy keymap))
        (set-keymap-parent parent)))))

Call FUNCTION once for each event binding in KEYMAP. FUNCTION is called with two arguments: the event that is bound, and the definition it is bound to. The event may be a character range. If KEYMAP has a parent, this function returns it without processing it.

(defun map-keymap-internal (function keymap))

Return current buffer's local keymap, or nil if it has none. Normally the local keymap is set by the major mode with `use-local-map'.

(defun current-local-map ()
  (when (data/boundp 'keymap)
    (buffer/buffer-local-value 'keymap (buffer/current-buffer))))

Return list of keys that invoke DEFINITION. If KEYMAP is a keymap, search only KEYMAP and the global keymap. If KEYMAP is nil, search all the currently active keymaps, except for `overriding-local-map' (which is ignored). If KEYMAP is a list of keymaps, search only those keymaps.

If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found, rather than a list of all possible key sequences. If FIRSTONLY is the symbol `non-ascii', return the first binding found, no matter what it is. If FIRSTONLY has another non-nil value, prefer bindings that use the modifier key specified in `where-is-preferred-modifier' (or their meta variants) and entirely reject menu bindings.

If optional 4th arg NOINDIRECT is non-nil, don't follow indirections to other keymaps or slots. This makes it possible to search for an indirect definition itself.

The optional 5th arg NO-REMAP alters how command remapping is handled:

  • If another command OTHER-COMMAND is remapped to DEFINITION, normally search for the bindings of OTHER-COMMAND and include them in the returned list. But if NO-REMAP is non-nil, include the vector [remap OTHER-COMMAND] in the returned list instead, without searching for those other bindings.

  • If DEFINITION is remapped to OTHER-COMMAND, normally return the bindings for OTHER-COMMAND. But if NO-REMAP is non-nil, return the bindings for DEFINITION instead, ignoring its remapping.

(defun where-is-internal (definition &optional keymap firstonly noindirect no-remap))

Return t if OBJECT is a keymap.

A keymap is a list (keymap . ALIST), or a symbol whose function definition is itself a keymap. ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN); a vector of densely packed bindings for small character codes is also allowed as an element.

(defun keymapp (object)
  (and (data/consp object) (= 'keymap (data/car object))))

Return a pretty description of file-character CHARACTER. Control characters turn into "^char", etc. This differs from `single-key-description' which turns them into "C-char". Also, this function recognizes the 2**7 bit as the Meta character, whereas `single-key-description' uses the 2**27 bit for Meta. See Info node `(elisp)Describing Characters' for examples.

(defun text-char-description (character))

Return a list of the currently active keymaps. OLP if non-nil indicates that we should obey `overriding-local-map' and `overriding-terminal-local-map'. POSITION can specify a click position like in the respective argument of `key-binding'.

http://www.gnu.org/software/emacs/manual/html_node/elisp/Searching-Keymaps.html "Here is a pseudo-Lisp description of the order and conditions for searching them:" (or (cond (overriding-terminal-local-map (find-in overriding-terminal-local-map)) (overriding-local-map (find-in overriding-local-map)) ((or (find-in (get-char-property (point) 'keymap)) (find-in temp-map) (find-in-any emulation-mode-map-alists) (find-in-any minor-mode-overriding-map-alist) (find-in-any minor-mode-map-alist) (if (get-text-property (point) 'local-map) (find-in (get-char-property (point) 'local-map)) (find-in (current-local-map)))))) (find-in (current-global-map))) "The function finally found might also be remapped. See Remapping Commands."

(defun current-active-maps (&optional olp position)
  (cons/maybe-seq (remove nil? (concat (when olp [(or (data/symbol-value 'overriding-terminal-local-map)
                                                      (data/symbol-value 'overriding-local-map))])
                                       (current-minor-mode-maps)
                                       [(textprop/get-char-property (or position (editfns/point)) 'local-map)
                                        (current-local-map)
                                        (current-global-map)]))))

Return the binding for command KEY in current keymaps. KEY is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition.

Normally, `key-binding' ignores bindings for t, which act as default bindings, used when nothing else in the keymap applies; this makes it usable as a general function for probing keymaps. However, if the optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does recognize the default bindings, just as `read-key-sequence' does.

Like the normal command loop, `key-binding' will remap the command resulting from looking up KEY by looking up the command in the current keymaps. However, if the optional third argument NO-REMAP is non-nil, `key-binding' returns the unmapped command.

If KEY is a key sequence initiated with the mouse, the used keymaps will depend on the clicked mouse position with regard to the buffer and possible local keymaps on strings.

If the optional argument POSITION is non-nil, it specifies a mouse position as returned by event-start' andevent-end', and the lookup occurs in the keymaps associated with it instead of KEY. It can also be a number or marker, in which case the keymap properties at the specified buffer position instead of point are used.

(defun key-binding (key &optional accept-default no-remap position)
  (some identity (remove number? (map #(lookup-key % key accept-default) (current-active-maps nil position)))))

Call FUNCTION once for each event binding in KEYMAP. FUNCTION is called with two arguments: the event that is bound, and the definition it is bound to. The event may be a character range.

If KEYMAP has a parent, the parent's bindings are included as well. This works recursively: if the parent has itself a parent, then the grandparent's bindings are also included and so on.

(defun map-keymap (function keymap)
  (el/check-type 'keymapp keymap)
  (apply alloc/list
         (map (fn [x] ((el/fun function) (data/car x) (data/cdr x)))
              (filter data/consp (data/cdr keymap)))))

Return the prompt-string of a keymap MAP. If non-nil, the prompt is shown in the echo-area when reading a key-sequence to be looked-up in this keymap.

(defun keymap-prompt (map)
  (first (filter string? (take-while (complement '#{keymap}) (next map)))))

Show all symbols whose names contain match for REGEXP. If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done for each symbol and a symbol is mentioned only if that returns non-nil. Return list of symbols found.

(defun apropos-internal (regexp &optional predicate))

Modify KEYMAP to set its parent map to PARENT. Return PARENT. PARENT should be nil or another keymap.

(defun set-keymap-parent (keymap parent)
  (el/check-type 'keymapp keymap)
  (when parent (el/check-type 'keymapp parent))
  (loop [x keymap]
    (when x
      (if (keymapp (data/cdr x))
        (data/setcdr x nil)
        (recur (data/cdr x)))))
  (fns/nconc keymap parent)
  parent)

Return a list of keymaps for the minor modes of the current buffer.

(defun current-minor-mode-maps ()
  (cons/maybe-seq (map data/cdr (filter (comp data/symbol-value data/car)
                                        (concat (data/symbol-value 'emulation-mode-map-alists)
                                                (data/symbol-value 'minor-mode-overriding-map-alist)
                                                (data/symbol-value 'minor-mode-map-alist))))))

Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST). CHARTABLE is a char-table that holds the bindings for all characters without modifiers. All entries in it are initially nil, meaning "command undefined". ALIST is an assoc-list which holds bindings for function keys, mouse events, and any other things that appear in the input stream. Initially, ALIST is nil.

The optional arg STRING supplies a menu name for the keymap in case you use it as a menu with `x-popup-menu'.

(defun make-keymap (&optional string)
  (fns/nconc (alloc/list 'keymap (chartab/make-char-table 'keymap))
             (when string (alloc/list string))))

Insert the list of all defined keys and their definitions. The list is inserted in the current buffer, while the bindings are looked up in BUFFER. The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix. The optional argument MENUS, if non-nil, says to mention menu bindings. (Ordinarily these are omitted from the output.)

(defun describe-buffer-bindings (buffer &optional prefix menus))

Find all keymaps accessible via prefix characters from KEYMAP. Returns a list of elements of the form (KEYS . MAP), where the sequence KEYS starting from KEYMAP gets you to MAP. These elements are ordered so that the KEYS increase in length. The first element is ([] . KEYMAP). An optional argument PREFIX, if non-nil, should be a key sequence; then the value includes only maps for prefixes that start with PREFIX.

(defun accessible-keymaps (keymap &optional prefix))

In keymap KEYMAP, look up key sequence KEY. Return the definition. A value of nil means undefined. See doc of `define-key' for kinds of definitions.

A number as value means KEY is "too long"; that is, characters or symbols in it except for the last one fail to be a valid sequence of prefix characters in KEYMAP. The number is how many characters at the front of KEY it takes to reach a non-prefix key.

Normally, `lookup-key' ignores bindings for t, which act as default bindings, used when nothing else in the keymap applies; this makes it usable as a general function for probing keymaps. However, if the third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will recognize the default bindings, just as `read-key-sequence' does.

(defun lookup-key (keymap key &optional accept-default)
  (let [key (if (string? key)
              (parser/parse-characters key (data/symbol-value 'meta-prefix-char))
              (el/check-type 'arrayp key))
        keymap (if (data/symbolp keymap) (data/symbol-value keymap) keymap)]
    (if-let [def (binding-map keymap key)]
      def
      (if-let [default (and accept-default (binding-map keymap #el/vec [t]))]
        default
        (when-let [parent (keymap-parent keymap)]
          (recur parent key accept-default))))))

Return a pretty description of key-sequence KEYS. Optional arg PREFIX is the sequence of keys leading up to KEYS. For example, [?C-x ?l] is converted into the string "C-x l".

The `kbd' macro is an approximate inverse of this.

(defun key-description (keys &optional prefix))

Return a pretty description of command character KEY. Control characters turn into C-whatever, etc. Optional argument NO-ANGLES non-nil means don't put angle brackets around function keys and event symbols.

(defun single-key-description (key &optional no-angles))

Select KEYMAP as the local keymap. If KEYMAP is nil, that means no local keymap.

(defun use-local-map (keymap)
  ;; This is not strictly correct, as these are some form of private buffer locals in Emacs.
  (el/check-type 'keymapp keymap)
  (data/make-local-variable 'keymap)
  (data/set 'keymap keymap))

Return the binding for command KEYS in current local keymap only. KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition.

If optional argument ACCEPT-DEFAULT is non-nil, recognize default bindings; see the description of `lookup-key' for more details about this.

(defun local-key-binding (keys &optional accept-default)
  (when (current-local-map)
    (lookup-key (current-local-map) keys accept-default)))

Define COMMAND as a prefix command. COMMAND should be a symbol. A new sparse keymap is stored as COMMAND's function definition and its value. If a second optional argument MAPVAR is given, the map is stored as its value instead of as COMMAND's value; but COMMAND is still defined as a function. The third optional argument NAME, if given, supplies a menu name string for the map. This is required to use the keymap as a menu. This function returns COMMAND.

(defun define-prefix-command (command &optional mapvar name)
  (let [keymap (make-sparse-keymap name)]
    (data/fset command keymap)
    (data/set (or mapvar command) keymap)
    command))

Return the parent keymap of KEYMAP. If KEYMAP has no parent, return nil.

(defun keymap-parent (keymap)
  (loop [x (data/cdr keymap)]
    (when x
      (if (keymapp x)
        x
        (recur (data/cdr x))))))

Return the binding for command KEYS in current global keymap only. KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. This function's return values are the same as those of `lookup-key' (which see).

If optional argument ACCEPT-DEFAULT is non-nil, recognize default bindings; see the description of `lookup-key' for more details about this.

(defun global-key-binding (keys &optional accept-default)
  (when (current-global-map)
    (lookup-key (current-global-map) keys accept-default)))

Return the current global keymap.

(defun current-global-map ()
  @*current-global-map*)

Return the remapping for command COMMAND. Returns nil if COMMAND is not remapped (or not a symbol).

If the optional argument POSITION is non-nil, it specifies a mouse position as returned by event-start' andevent-end', and the remapping occurs in the keymaps associated with it. It can also be a number or marker, in which case the keymap properties at the specified buffer position instead of point are used. The KEYMAPS argument is ignored if POSITION is non-nil.

If the optional argument KEYMAPS is non-nil, it should be a list of keymaps to search for command remapping. Otherwise, search for the remapping in all currently active keymaps.

(defun command-remapping (command &optional position keymaps))

Find the visible minor mode bindings of KEY. Return an alist of pairs (MODENAME . BINDING), where MODENAME is the symbol which names the minor mode binding KEY, and BINDING is KEY's definition in that mode. In particular, if KEY has no minor-mode bindings, return nil. If the first binding is a non-prefix, all subsequent bindings will be omitted, since they would be ignored. Similarly, the list doesn't include non-prefix bindings that come after prefix bindings.

If optional argument ACCEPT-DEFAULT is non-nil, recognize default bindings; see the description of `lookup-key' for more details about this.

(defun minor-mode-key-binding (key &optional accept-default)
  (some #(lookup-key % accept-default) (current-minor-mode-maps)))

Insert a description of contents of VECTOR. This is text showing the elements of vector matched against indices. DESCRIBER is the output function used; nil means use `princ'.

(defun describe-vector (vector &optional describer))

Select KEYMAP as the global keymap.

(defun use-global-map (keymap)
  (el/check-type 'keymapp keymap)
  (reset! *current-global-map* keymap)
  nil)
 
(ns deuce.emacs.xml
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c])
  (:refer-clojure :exclude []))

Parse the region as an HTML document and return the parse tree. If BASE-URL is non-nil, it is used to expand relative URLs.

(defun libxml-parse-html-region (start end &optional base-url))

Parse the region as an XML document and return the parse tree. If BASE-URL is non-nil, it is used to expand relative URLs.

(defun libxml-parse-xml-region (start end &optional base-url))
 
(ns deuce.emacs.terminal
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.frame :as frame]
            [deuce.emacs-lisp.cons :as cons]
            [deuce.emacs-lisp.globals :as globals])
  (:import [deuce.emacs.data Frame]
           [com.googlecode.lanterna.screen Screen TerminalScreen]
           [com.googlecode.lanterna.terminal DefaultTerminalFactory])
  (:refer-clojure :exclude []))

Special hook run when a terminal is deleted. Each function is called with argument, the terminal. This may be called just before actually deleting the terminal, or some time later.

(defvar delete-terminal-functions nil)

Non-nil means call this function to ring the bell. The function should accept no arguments.

(defvar ring-bell-function nil)
(defn ^:private init-initial-terminal []
  (let [terminal (TerminalScreen. (.createTerminal (doto (DefaultTerminalFactory.)
                                                     (.setForceTextTerminal true))))]
    (reset! (.terminal ^Frame globals/terminal-frame) terminal)
    (.startScreen terminal)))

Return a list of all terminal devices.

(defun terminal-list ()
  (cons/maybe-seq (remove nil? (map #(deref (.terminal ^Frame %)) (frame/frame-list)))))

Return TERMINAL's value for parameter PARAMETER. TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal).

(defun terminal-parameter (terminal parameter))
(declare frame-terminal)

Return non-nil if OBJECT is a terminal which has not been deleted. Value is nil if OBJECT is not a live display terminal. If object is a live display terminal, the return value indicates what sort of output terminal it uses. See the documentation of `framep' for possible return values.

(defun terminal-live-p (object)
  (when (frame-terminal)
    true))

Return the terminal that FRAME is displayed on. If FRAME is nil, the selected frame is used.

The terminal device is represented by its integer identifier.

(defun frame-terminal (&optional frame)
  (let [^Frame frame (or frame (frame/selected-frame))]
    @(.terminal frame)))

Delete TERMINAL by deleting all frames on it and closing the terminal. TERMINAL may be a terminal object, a frame, or nil (meaning the selected frame's terminal).

Normally, you may not delete a display if all other displays are suspended, but if the second argument FORCE is non-nil, you may do so.

(defun delete-terminal (&optional terminal force)
  (when-let [terminal (or terminal (frame-terminal))]
    (eval/run-hook-with-args 'delete-terminal-functions terminal)
    ((ns-resolve 'deuce.main 'stop-ui))
    (.stopScreen ^Screen terminal)
    (when (= terminal (frame-terminal))
      (reset! (.terminal ^Frame globals/terminal-frame) nil))))

Set TERMINAL's value for parameter PARAMETER to VALUE. Return the previous value of PARAMETER.

TERMINAL can be a terminal object, a frame or nil (meaning the selected frame's terminal).

(defun set-terminal-parameter (terminal parameter value))

Return the parameter-alist of terminal TERMINAL. The value is a list of elements of the form (PARM . VALUE), where PARM is a symbol.

TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal).

(defun terminal-parameters (&optional terminal))

Return the name of the terminal device TERMINAL. It is not guaranteed that the returned value is unique among opened devices.

TERMINAL may be a terminal object, a frame, or nil (meaning the selected frame's terminal).

(defun terminal-name (&optional terminal))
 
(ns deuce.emacs.syntax
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.cmds :as cmds]
            [deuce.emacs.fns :as fns]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.search :as search]
            [deuce.emacs-lisp :as el]
            [taoensso.timbre :as timbre])
  (:refer-clojure :exclude []))

Non-nil means `forward-word', etc., should treat escape chars part of words.

You can customize this variable.

(defvar words-include-escapes nil)

Non-nil means forward-sexp', etc., obeysyntax-table' property. Otherwise, that text property is simply ignored. See the info node `(elisp)Syntax Properties' for a description of the `syntax-table' property.

(defvar parse-sexp-lookup-properties nil)

Non-nil means `scan-sexps' treats all multibyte characters as symbol.

(defvar multibyte-syntax-as-symbol nil)

Non-nil means `forward-sexp', etc., should treat comments as whitespace.

You can customize this variable.

(defvar parse-sexp-ignore-comments nil)

Char table of functions to search for the word boundary. Each function is called with two arguments; POS and LIMIT. POS and LIMIT are character positions in the current buffer.

If POS is less than LIMIT, POS is at the first character of a word, and the return value of a function is a position after the last character of that word.

If POS is not less than LIMIT, POS is at the last character of a word, and the return value of a function is a position at the first character of that word.

In both cases, LIMIT bounds the search.

(defvar find-word-boundary-function-table nil)

*Non-nil means an open paren in column 0 denotes the start of a defun.

You can customize this variable.

(defvar open-paren-in-column-0-is-defun-start nil)
(fns/put 'syntax-table 'char-table-extra-slots 0)
(declare skip-chars-forward skip-chars-backward)

Return the standard syntax table. This is the one used for new buffers.

(defun standard-syntax-table ())

Parse Lisp syntax starting at FROM until TO; return status of parse at TO. Parsing stops at TO or when certain criteria are met; point is set to where parsing stops. If fifth arg OLDSTATE is omitted or nil, parsing assumes that FROM is the beginning of a function. Value is a list of elements describing final state of parsing: 0. depth in parens. 1. character address of start of innermost containing list; nil if none. 2. character address of start of last complete sexp terminated. 3. non-nil if inside a string. (it is the character that will terminate the string, or t if the string should be terminated by a generic string delimiter.) 4. nil if outside a comment, t if inside a non-nestable comment, else an integer (the current comment nesting). 5. t if following a quote character. 6. the minimum paren-depth encountered during this scan. 7. style of comment, if any. 8. character address of start of comment or string; nil if not in one. 9. Intermediate data for continuation of parsing (subject to change). If third arg TARGETDEPTH is non-nil, parsing stops if the depth in parentheses becomes equal to TARGETDEPTH. Fourth arg STOPBEFORE non-nil means stop when come to any character that starts a sexp. Fifth arg OLDSTATE is a list like what this function returns. It is used to initialize the state of the parse. Elements number 1, 2, 6 and 8 are ignored. Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it is symbol `syntax-table', stop after the start of a comment or a string, or after end of a comment or a string.

(defun parse-partial-sexp (from to &optional targetdepth stopbefore oldstate commentstop))

Scan from character number FROM by COUNT balanced expressions. If COUNT is negative, scan backwards. Returns the character number of the position thus found.

Comments are ignored if `parse-sexp-ignore-comments' is non-nil.

If the beginning or end of (the accessible part of) the buffer is reached in the middle of a parenthetical grouping, an error is signaled. If the beginning or end is reached between groupings but before count is used up, nil is returned.

(defun scan-sexps (from count))

Return t if OBJECT is a syntax table. Currently, any char-table counts as a syntax table.

(defun syntax-table-p (object))

Move point forward ARG words (backward if ARG is negative). Normally returns t. If an edge of the buffer or a field boundary is reached, point is left there and the function returns nil. Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil.

(defun forward-word (&optional arg)
  (interactive "^p")
  (let [arg (el/check-type 'numberp (or arg 1))]
    (if (pos? arg)
      (do
        (dotimes [_ arg]
          (skip-chars-forward "\\W")
          (skip-chars-forward "\\w"))
        (when-not (editfns/eobp) true))
      (do
        (dotimes [_ (- arg)]
          (skip-chars-backward "\\W")
          (skip-chars-backward "\\w"))
        (when-not (editfns/bobp) true)))))

Scan from character number FROM by COUNT lists. Scan forward if COUNT is positive, backward if COUNT is negative. Return the character number of the position thus found.

A "list", in this context, refers to a balanced parenthetical grouping, as determined by the syntax table.

If DEPTH is nonzero, treat that as the nesting depth of the starting point (i.e. the starting point is DEPTH parentheses deep). This function scans over parentheses until the depth goes to zero COUNT times. Hence, positive DEPTH moves out that number of levels of parentheses, while negative DEPTH moves to a deeper level.

Comments are ignored if `parse-sexp-ignore-comments' is non-nil.

If we reach the beginning or end of the accessible part of the buffer before we have scanned over COUNT lists, return nil if the depth at that point is zero, and signal a error if the depth is nonzero.

(defun scan-lists (from count depth))
(defn ^:private skip-pattern [s]
  (re-pattern (str "[" (el/check-type 'stringp s) "]")))

Move point backward, stopping after a char not in STRING, or at pos LIM. See `skip-chars-forward' for details. Returns the distance traveled, either zero or negative.

(defun skip-chars-backward (string &optional lim)
  (let [lim (el/check-type 'numberp (or lim (editfns/point-min)))]
    (while (and (not= lim (editfns/point))
                (re-find (skip-pattern string)
                         (str (editfns/char-before))))
      (cmds/backward-char))))

Move point backward over any number of chars with prefix syntax. This includes chars with "quote" or "prefix" syntax (' or p).

(defun backward-prefix-chars ())

Construct a new syntax table and return it. It is a copy of the TABLE, which defaults to the standard syntax table.

(defun copy-syntax-table (&optional table))

Return the current syntax table. This is the one specified by the current buffer.

(defun syntax-table ())

Move point backward across chars in specified syntax classes. SYNTAX is a string of syntax code characters. Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM. If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX. This function returns the distance traveled, either zero or negative.

(defun skip-syntax-backward (syntax &optional lim))

Move forward across up to COUNT comments. If COUNT is negative, move backward. Stop scanning if we find something other than a comment or whitespace. Set point to where scanning stops. If COUNT comments are found as expected, with nothing except whitespace between them, return t; otherwise return nil.

(defun forward-comment (count))

Move point forward across chars in specified syntax classes. SYNTAX is a string of syntax code characters. Stop before a char whose syntax is not in SYNTAX, or at position LIM. If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX. This function returns the distance traveled, either zero or positive.

(defun skip-syntax-forward (syntax &optional lim))

Select a new syntax table for the current buffer. One argument, a syntax table.

(defun set-syntax-table (table))

Set syntax for character CHAR according to string NEWENTRY. The syntax is changed only for table SYNTAX-TABLE, which defaults to the current buffer's syntax table. CHAR may be a cons (MIN . MAX), in which case, syntaxes of all characters in the range MIN to MAX are changed. The first character of NEWENTRY should be one of the following: Space or - whitespace syntax. w word constituent. _ symbol constituent. . punctuation. ( open-parenthesis. ) close-parenthesis. " string quote. \ escape. $ paired delimiter. ' expression quote or prefix operator. < comment starter. > comment ender. / character-quote. @ inherit from `standard-syntax-table'. | generic string fence. ! generic comment fence.

Only single-character comment start and end sequences are represented thus. Two-character sequences are represented as described below. The second character of NEWENTRY is the matching parenthesis, used only if the first character is (' or)'. Any additional characters are flags. Defined flags are the characters 1, 2, 3, 4, b, p, and n. 1 means CHAR is the start of a two-char comment start sequence. 2 means CHAR is the second character of such a sequence. 3 means CHAR is the start of a two-char comment end sequence. 4 means CHAR is the second character of such a sequence.

There can be several orthogonal comment sequences. This is to support language modes such as C++. By default, all comment sequences are of style a, but you can set the comment sequence style to b (on the second character of a comment-start, and the first character of a comment-end sequence) and/or c (on any of its chars) using this flag: b means CHAR is part of comment sequence b. c means CHAR is part of comment sequence c. n means CHAR is part of a nestable comment sequence.

p means CHAR is a prefix character for `backward-prefix-chars'; such characters are treated as whitespace when they occur between expressions.

(defun modify-syntax-entry (char newentry &optional syntax-table)
  "Set syntax for character CHAR according to string NEWENTRY.
  The syntax is changed only for table SYNTAX-TABLE, which defaults to
   the current buffer's syntax table.
  CHAR may be a cons (MIN . MAX), in which case, syntaxes of all characters
  in the range MIN to MAX are changed.
  The first character of NEWENTRY should be one of the following:
    Space or -  whitespace syntax.    w   word constituent.
    _           symbol constituent.   .   punctuation.
    (           open-parenthesis.     )   close-parenthesis.
    \"           string quote.         \\   escape.
    $           paired delimiter.     '   expression quote or prefix operator.
    <           comment starter.      >   comment ender.
    /           character-quote.      @   inherit from `standard-syntax-table'.
    |           generic string fence. !   generic comment fence.
  Only single-character comment start and end sequences are represented thus.
  Two-character sequences are represented as described below.
  The second character of NEWENTRY is the matching parenthesis,
   used only if the first character is `(' or `)'.
  Any additional characters are flags.
  Defined flags are the characters 1, 2, 3, 4, b, p, and n.
   1 means CHAR is the start of a two-char comment start sequence.
   2 means CHAR is the second character of such a sequence.
   3 means CHAR is the start of a two-char comment end sequence.
   4 means CHAR is the second character of such a sequence.
  There can be several orthogonal comment sequences.  This is to support
  language modes such as C++.  By default, all comment sequences are of style
  a, but you can set the comment sequence style to b (on the second character
  of a comment-start, and the first character of a comment-end sequence) and/or
  c (on any of its chars) using this flag:
   b means CHAR is part of comment sequence b.
   c means CHAR is part of comment sequence c.
   n means CHAR is part of a nestable comment sequence.
   p means CHAR is a prefix character for `backward-prefix-chars';
     such characters are treated as whitespace when they occur
     between expressions."
  (interactive "cSet syntax for character: \nsSet syntax for %s to: "))

Return the matching parenthesis of CHARACTER, or nil if none.

(defun matching-paren (character))

Move point forward, stopping before a char not in STRING, or at pos LIM. STRING is like the inside of a `[...]' in a regular expression except that ]' is never special and\' quotes ^',-' or `\' (but not at the end of a range; quoting is never needed there). Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter. With arg "^a-zA-Z", skips nonletters stopping before first letter. Char classes, e.g. `[:alpha:]', are supported.

Returns the distance traveled, either zero or positive.

(defun skip-chars-forward (string &optional lim)
  "Move point forward, stopping before a char not in STRING, or at pos LIM.
  STRING is like the inside of a `[...]' in a regular expression
  except that `]' is never special and `\\' quotes `^', `-' or `\\'
   (but not at the end of a range; quoting is never needed there).
  Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.
  With arg \"^a-zA-Z\", skips nonletters stopping before first letter.
  Char classes, e.g. `[:alpha:]', are supported.
  Returns the distance traveled, either zero or positive."
  (let [lim (el/check-type 'numberp (or lim (editfns/point-max)))]
    (while  (and (not= lim (editfns/point))
                 (re-find (skip-pattern string)
                          (str (editfns/char-after))))
      (cmds/forward-char))))

Return the syntax code of CHARACTER, described by a character. For example, if CHARACTER is a word constituent, the character `w' (119) is returned. The characters that correspond to various syntax codes are listed in the documentation of `modify-syntax-entry'.

(defun char-syntax (character))

Convert a syntax specification STRING into syntax cell form. STRING should be a string as it is allowed as argument of `modify-syntax-entry'. Value is the equivalent cons cell (CODE . MATCHING-CHAR) that can be used as value of a `syntax-table' text property.

(defun string-to-syntax (string))

Insert a description of the internal syntax description SYNTAX at point.

(defun internal-describe-syntax-value (syntax))
 
(ns deuce.emacs.search
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs-lisp.cons :as cons]
            [taoensso.timbre :as timbre])
  (:refer-clojure :exclude [])
  (:import [java.util.regex Pattern PatternSyntaxException]))

Internal use only. If non-nil, the primitive searching and matching functions such as looking-at',string-match', `re-search-forward', etc., do not set the match data. The proper way to use this variable is to bind it with `let' around a small expression.

(defvar inhibit-changing-match-data nil)

Regexp to substitute for bunches of spaces in regexp search. Some commands use this for user-specified regexps. Spaces that occur inside character classes or repetition operators or other such regexp constructs are not replaced with this. A value of nil (which is the normal value) means treat spaces literally.

(defvar search-spaces-regexp nil)
(declare string-match re-search-forward regexp-quote
         match-beginning match-end match-data set-match-data)
(def ^:private current-match-data (atom nil))

Return a regexp which matches words, ignoring punctuation. Given STRING, a string of words separated by word delimiters, compute a regexp that matches those exact words separated by arbitrary punctuation. If LAX is non-nil, the end of the string need not match a word boundary unless it ends in whitespace.

Used in word-search-forward',word-search-backward', word-search-forward-lax',word-search-backward-lax'.

(defun word-search-regexp (string &optional lax)
  (str "\\b" (s/replace (s/trim string) #"\W+" "\\\\W\\\\W*")
       (when (or (not lax) (re-find #"\s$" string)) "\\b")))

Search forward from point for STRING. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. The match found must not extend after that position. A value of nil is equivalent to (point-max). Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument COUNT, if non-nil, means to search for COUNT successive occurrences. If COUNT is negative, search backward, instead of forward, for -COUNT occurrences.

Search case-sensitivity is determined by the value of the variable `case-fold-search', which see.

See also the functions match-beginning',match-end' and `replace-match'.

(defun search-forward (string &optional bound noerror count)
  (interactive "MSearch: ")
  (re-search-forward (regexp-quote string) bound noerror count))

Search backward from point for match for regular expression REGEXP. Set point to the beginning of the match, and return point. The match found is the one starting last in the buffer and yet ending before the origin of the search. An optional second argument bounds the search; it is a buffer position. The match found must start at or after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Search case-sensitivity is determined by the value of the variable `case-fold-search', which see.

See also the functions match-beginning',match-end', `match-string', and `replace-match'.

(defun re-search-backward (regexp &optional bound noerror count)
  (interactive "sRE search backward: ")
  (let [point (editfns/point)
        count (el/check-type 'integerp (or count 1))]
    (cond
     (zero? count) point
     (neg? count) (re-search-forward regexp bound noerror (- count))
     :else
     (let [bound (el/check-type 'integerp (or bound 1))]
       (loop [offset (editfns/goto-char bound)
              matches []]
         (if (string-match (el/check-type 'stringp regexp)
                           (subs (editfns/buffer-string) 0 (dec point))
                           (dec offset))
           (when (< (editfns/goto-char (match-end 0)) point)
             (recur (editfns/point) (conj matches (match-data))))
           (if-let [match (nth (reverse matches) (dec count) nil)]
             (do (set-match-data match)
                 (editfns/goto-char (inc (first match))))
             (do (editfns/goto-char (if-not (contains? #{nil true} noerror)
                                      bound
                                      point))
                 (when-not noerror
                   (el/throw* 'search-failed (format "Search failed: %s" regexp)))))))))))

Set internal data on last search match from elements of LIST. LIST should have been created by calling `match-data' previously.

If optional arg RESEAT is non-nil, make markers on LIST point nowhere.

(defun set-match-data (list &optional reseat)
  (reset! current-match-data list))

Search forward from point for STRING, ignoring differences in punctuation. Set point to the end of the occurrence found, and return point.

Unlike `word-search-forward', the end of STRING need not match a word boundary, unless STRING ends in whitespace.

An optional second argument bounds the search; it is a buffer position. The match found must not extend after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard to punctuation.

(defun word-search-forward-lax (string &optional bound noerror count)
  (interactive "sWord search: ")
  (re-search-forward (word-search-regexp string true) bound noerror count))

Search backward from point for STRING, ignoring differences in punctuation. Set point to the beginning of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. The match found must not extend before that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard to punctuation.

(defun word-search-backward (string &optional bound noerror count)
  (interactive "sWord search backward: ")
  (re-search-backward (word-search-regexp string) bound noerror count))

Search forward from point for regular expression REGEXP. Find the longest match in accord with Posix regular expression rules. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. The match found must not extend after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Search case-sensitivity is determined by the value of the variable `case-fold-search', which see.

See also the functions match-beginning',match-end', `match-string', and `replace-match'.

(defun posix-search-forward (regexp &optional bound noerror count)
  (interactive "sPosix search: ")
  (search-forward regexp bound noerror count))

Search forward from point for STRING, ignoring differences in punctuation. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. The match found must not extend after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard to punctuation.

(defun word-search-forward (string &optional bound noerror count)
  (interactive "sWord search: ")
  (re-search-forward (word-search-regexp string) bound noerror count))

Search backward from point for STRING, ignoring differences in punctuation. Set point to the beginning of the occurrence found, and return point.

Unlike `word-search-backward', the end of STRING need not match a word boundary, unless STRING ends in whitespace.

An optional second argument bounds the search; it is a buffer position. The match found must not extend before that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Relies on the function `word-search-regexp' to convert a sequence of words in STRING to a regexp used to search words without regard to punctuation.

(defun word-search-backward-lax (string &optional bound noerror count)
  (interactive "sWord search backward: ")
  (re-search-backward (word-search-regexp string true) bound noerror count))

Return t if text after point matches regular expression REGEXP. This function modifies the match data that `match-beginning', match-end' andmatch-data' access; save and restore the match data if you want to preserve them.

(defun looking-at (regexp)
  (when (string-match (str "^" (el/check-type 'stringp regexp))
                      (editfns/buffer-string)
                      (dec (editfns/point)))
    true))

Search forward from point for regular expression REGEXP. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. The match found must not extend after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Search case-sensitivity is determined by the value of the variable `case-fold-search', which see.

See also the functions match-beginning',match-end', `match-string', and `replace-match'.

(defun re-search-forward (regexp &optional bound noerror count)
  (interactive "sRE search: ")
  (let [point (editfns/point)
        count (el/check-type 'integerp (or count 1))]
    (cond
     (zero? count) point
     (neg? count) (re-search-backward regexp bound noerror (- count))
     :else
     (let [bound (el/check-type 'integerp (or bound (inc (editfns/buffer-size))))]
       (loop [count (dec count)]
         (if (string-match (el/check-type 'stringp regexp)
                           (subs (editfns/buffer-string) 0 (dec bound))
                           (dec (editfns/point)))
           (do (editfns/goto-char (inc (match-end 0)))
               (if (zero? count)
                 (editfns/point)
                 (recur (dec count))))
           (do (editfns/goto-char (if-not (contains? #{nil true} noerror)
                                    bound
                                    point))
               (when-not noerror
                 (el/throw* 'search-failed (format "Search failed: %s" regexp))))))))))

Return index of start of first match for REGEXP in STRING, or nil. Find the longest match, in accord with Posix regular expression rules. Case is ignored if `case-fold-search' is non-nil in the current buffer. If third arg START is non-nil, start search at that index in STRING. For index of first char beyond the match, do (match-end 0). match-end' andmatch-beginning' also give indices of substrings matched by parenthesis constructs in the pattern.

(defun posix-string-match (regexp string &optional start)
  (string-match regexp string start))
(defn ^:private emacs-regex-to-java [regexp]
  (-> regexp
      (s/replace #"^\\\`" "^")
      (s/replace #"\\\|" "|")
      (s/replace #"\[(]?.*?)]"
                 (fn [x]
                   (str "[" (s/replace
                             (s/replace (x 1) "\\" "\\\\")
                             "[" "\\[")
                        "]")))
      (s/replace "\\(" "(")
      (s/replace "\\)" ")")))

Return index of start of first match for REGEXP in STRING, or nil. Matching ignores case if `case-fold-search' is non-nil. If third arg START is non-nil, start search at that index in STRING. For index of first char beyond the match, do (match-end 0). match-end' andmatch-beginning' also give indices of substrings matched by parenthesis constructs in the pattern.

You can use the function `match-string' to extract the substrings matched by the parenthesis constructions in REGEXP.

(defun string-match (regexp string &optional start)
  ;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Regexp-Special.html
  (el/check-type 'stringp regexp)
  (el/check-type 'stringp string)
  (let [pattern (emacs-regex-to-java regexp)]
    (let [offset (el/check-type 'integerp (or start 0))
          ignore-case? (data/symbol-value 'case-fold-search)
          m (re-matcher (re-pattern (str (if ignore-case? "(?iu)" "") pattern))
                        (subs string offset))
          inhibit? (data/symbol-value 'inhibit-changing-match-data)]
      (if (re-find m)
        (let [m (cons/maybe-seq
                 (map (partial + offset)
                      (mapcat #(vector (.start m (int %)) (.end m (int %)))
                              (range (inc (.groupCount m))))))]
          (when-not inhibit?
            (reset! current-match-data m))
          (first m))
        (when-not inhibit?
          (reset! current-match-data nil))))))

Return t if text after point matches regular expression REGEXP. Find the longest match, in accord with Posix regular expression rules. This function modifies the match data that `match-beginning', match-end' andmatch-data' access; save and restore the match data if you want to preserve them.

(defun posix-looking-at (regexp)
  (looking-at regexp))

Return a list containing all info on what the last search matched. Element 2N is (match-beginning N)'; element 2N + 1 is(match-end N)'. All the elements are markers or nil (nil if the Nth pair didn't match) if the last match was on a buffer; integers or nil if a string was matched. Use `set-match-data' to reinstate the data in this list.

If INTEGERS (the optional first argument) is non-nil, always use integers (rather than markers) to represent buffer positions. In this case, and if the last match was in a buffer, the buffer will get stored as one additional element at the end of the list.

If REUSE is a list, reuse it as part of the value. If REUSE is long enough to hold all the values, and if INTEGERS is non-nil, no consing is done.

If optional third arg RESEAT is non-nil, any previous markers on the REUSE list will be modified to point to nowhere.

Return value is undefined if the last search failed.

(defun match-data (&optional integers reuse reseat)
  @current-match-data)

Replace text matched by last search with NEWTEXT. Leave point at the end of the replacement text.

If second arg FIXEDCASE is non-nil, do not alter case of replacement text. Otherwise maybe capitalize the whole text, or maybe just word initials, based on the replaced text. If the replaced text has only capital letters and has at least one multiletter word, convert NEWTEXT to all caps. Otherwise if all words are capitalized in the replaced text, capitalize each word in NEWTEXT.

If third arg LITERAL is non-nil, insert NEWTEXT literally. Otherwise treat `\' as special: `\&' in NEWTEXT means substitute original matched text. \N' means substitute what matched the Nth(...)'. If Nth parens didn't match, substitute nothing. \\' means insert one\'. Case conversion does not apply to these substitutions.

FIXEDCASE and LITERAL are optional arguments.

The optional fourth argument STRING can be a string to modify. This is meaningful when the previous match was done against STRING, using string-match'. When used this way,replace-match' creates and returns a new string made by copying STRING and replacing the part of STRING that was matched.

The optional fifth argument SUBEXP specifies a subexpression; it says to replace just that subexpression with NEWTEXT, rather than replacing the entire matched text. This is, in a vague sense, the inverse of using `\N' in NEWTEXT; `\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts NEWTEXT in place of subexp N. This is useful only after a regular expression search or match, since only regular expressions have distinguished subexpressions.

(defun replace-match (newtext &optional fixedcase literal string subexp)
  "Replace text matched by last search with NEWTEXT.
  Leave point at the end of the replacement text.
  If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
  Otherwise maybe capitalize the whole text, or maybe just word initials,
  based on the replaced text.
  If the replaced text has only capital letters
  and has at least one multiletter word, convert NEWTEXT to all caps.
  Otherwise if all words are capitalized in the replaced text,
  capitalize each word in NEWTEXT.
  If third arg LITERAL is non-nil, insert NEWTEXT literally.
  Otherwise treat `\\' as special:
    `\\&' in NEWTEXT means substitute original matched text.
    `\\N' means substitute what matched the Nth `\\(...\\)'.
         If Nth parens didn't match, substitute nothing.
    `\\\\' means insert one `\\'.
  Case conversion does not apply to these substitutions.
  FIXEDCASE and LITERAL are optional arguments.
  The optional fourth argument STRING can be a string to modify.
  This is meaningful when the previous match was done against STRING,
  using `string-match'.  When used this way, `replace-match'
  creates and returns a new string made by copying STRING and replacing
  the part of STRING that was matched.
  The optional fifth argument SUBEXP specifies a subexpression;
  it says to replace just that subexpression with NEWTEXT,
  rather than replacing the entire matched text.
  This is, in a vague sense, the inverse of using `\\N' in NEWTEXT;
  `\\N' copies subexp N into NEWTEXT, but using N as SUBEXP puts
  NEWTEXT in place of subexp N.
  This is useful only after a regular expression search or match,
  since only regular expressions have distinguished subexpressions."
  (let [group (el/check-type 'integerp (or subexp 0))]
    (editfns/goto-char (inc (match-beginning group)))
    (editfns/delete-region (inc (match-beginning group)) (inc (match-end group)))
    (editfns/insert newtext)))

Return position of start of text matched by last search. SUBEXP, a number, specifies which parenthesized expression in the last regexp. Value is nil if SUBEXPth pair didn't match, or there were less than SUBEXP pairs. Zero means the entire text matched by the whole regexp or whole string.

(defun match-beginning (subexp)
  (when @current-match-data
    (nth @current-match-data (* subexp 2) nil)))

Search backward from point for STRING. Set point to the beginning of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. The match found must not extend before that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, position at limit of search and return nil. Optional fourth argument COUNT, if non-nil, means to search for COUNT successive occurrences. If COUNT is negative, search forward, instead of backward, for -COUNT occurrences.

Search case-sensitivity is determined by the value of the variable `case-fold-search', which see.

See also the functions match-beginning',match-end' and `replace-match'.

(defun search-backward (string &optional bound noerror count)
  (interactive "MSearch backward: ")
  (re-search-backward (regexp-quote string) bound noerror count))

Return position of end of text matched by last search. SUBEXP, a number, specifies which parenthesized expression in the last regexp. Value is nil if SUBEXPth pair didn't match, or there were less than SUBEXP pairs. Zero means the entire text matched by the whole regexp or whole string.

(defun match-end (subexp)
  (when @current-match-data
    (nth @current-match-data (inc (* subexp 2)) nil)))

Search backward from point for match for regular expression REGEXP. Find the longest match in accord with Posix regular expression rules. Set point to the beginning of the match, and return point. The match found is the one starting last in the buffer and yet ending before the origin of the search. An optional second argument bounds the search; it is a buffer position. The match found must start at or after that position. Optional third argument, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil. Optional fourth argument is repeat count--search for successive occurrences.

Search case-sensitivity is determined by the value of the variable `case-fold-search', which see.

See also the functions match-beginning',match-end', `match-string', and `replace-match'.

(defun posix-search-backward (regexp &optional bound noerror count)
  (interactive "sPosix search backward: ")
  (search-backward regexp bound noerror count))

Return a regexp string which matches exactly STRING and nothing else.

(defun regexp-quote (string)
  (let [slash (str (gensym "SLASH"))]
    (s/replace
     (reduce #(s/replace %1 (str %2) (str "\\" %2)) (s/replace (el/check-type 'stringp string) "\\" slash)
             "[*.?+^$")
     slash "\\\\")))
 
(ns deuce.emacs.callint
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [clojure.string :as s]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs.editfns :as editfns]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.lread :as lread]
            [deuce.emacs.marker :as marker]
            [taoensso.timbre :as timbre])
  (::refer-clojure :exclude []))

The value of the prefix argument for the next editing command. It may be a number, or the symbol `-' for just a minus sign as arg, or a list whose car is a number for just one or more C-u's or nil if no argument has been specified.

You cannot examine this variable to find the argument for this command since it has been set to nil by the time you can look. Instead, you should use the variable `current-prefix-arg', although normally commands can get this prefix argument with (interactive "P").

(defvar prefix-arg nil)

List of recent commands that read arguments from terminal. Each command is represented as a form to evaluate.

Maximum length of the history list is determined by the value of `history-length', which see.

(defvar command-history nil)

The value of the prefix argument for the previous editing command. See `prefix-arg' for the meaning of the value.

(defvar last-prefix-arg nil)

Debugging status of current interactive command. Bound each time `call-interactively' is called; may be set by the debugger as a reminder for itself.

(defvar command-debug-status nil)

The value of the prefix argument for this editing command. It may be a number, or the symbol `-' for just a minus sign as arg, or a list whose car is a number for just one or more C-u's or nil if no argument has been specified. This is what `(interactive "P")' returns.

(defvar current-prefix-arg nil)

*Non-nil means you can use the mark even when inactive. This option makes a difference in Transient Mark mode. When the option is non-nil, deactivation of the mark turns off region highlighting, but commands that use the mark behave as if the mark were still active.

You can customize this variable.

(defvar mark-even-if-inactive nil)

Hook to run when about to switch windows with a mouse command. Its purpose is to give temporary modes such as Isearch mode a way to turn themselves off when a mouse command switches windows.

(defvar mouse-leave-buffer-hook nil)
(declare prefix-numeric-value)

See callint.c for the full set, many enter recursive edit and read the arguments from the minibuffer.

(defn ^:private parse-interactive [arg]
  (let [[[_ mods [code & prompt]]] (re-seq #"([@*^]*)(.+)" arg)
        prompt (apply str prompt)]
    (doseq [m (distinct mods)]
      (case m
        \* (buffer/barf-if-buffer-read-only)
        \^ (timbre/warn "should handle shift translation for " arg "shift-select-mode:"
                        (data/symbol-value 'shift-select-mode))
        \@ (timbre/debug "should select window if mouse event for " arg)))
    (case code
      \b [(buffer/buffer-name)]
      \m [(marker/marker-position (editfns/mark-marker))]
      \r [(editfns/region-beginning) (editfns/region-end)]
      \P [(data/symbol-value 'current-prefix-arg)]
      \p [(prefix-numeric-value (data/symbol-value 'current-prefix-arg))])))

Call FUNCTION, providing args according to its interactive calling specs. Return the value FUNCTION returns. The function contains a specification of how to do the argument reading. In the case of user-defined functions, this is specified by placing a call to the function `interactive' at the top level of the function body. See `interactive'.

Optional second arg RECORD-FLAG non-nil means unconditionally put this command in the command-history. Otherwise, this is done only if an arg is read using the minibuffer.

Optional third arg KEYS, if given, specifies the sequence of events to supply, as a vector, if the command inquires which events were used to invoke it. If KEYS is omitted or nil, the return value of `this-command-keys-vector' is used.

(defun call-interactively (function &optional record-flag keys)
  (el/check-type 'commandp function)
  (let [keys (or keys (eval/funcall 'this-command-keys-vector))
        f (data/symbol-function function)
        interactive (:interactive (meta f))
        args (condp some [interactive]
              (comp #{\)} first) (eval/eval (lread/read interactive))
              seq? (eval/eval interactive)
              nil? nil
              (mapcat parse-interactive (s/split interactive #"\n")))]
    (when record-flag
      (el/setq command-history (alloc/cons (alloc/cons f args) (data/symbol-value 'command-history))))
    (apply eval/funcall f args)))

Return numeric meaning of raw prefix argument RAW. A raw prefix argument is what you get from `(interactive "P")'. Its numeric meaning is what you would get from `(interactive "p")'.

(defun prefix-numeric-value (raw)
  (if (data/numberp raw)
    (int raw)
    1))
 
(ns deuce.emacs.alloc
  (:use [deuce.emacs-lisp :only (defun defvar) :as el]
        [taoensso.timbre :as timbre
         :only (trace debug info warn error fatal spy)])
  (:require [clojure.core :as c]
            [clojure.walk :as w]
            [deuce.emacs-lisp.cons :as cons])
  (:refer-clojure :exclude [vector cons list])
  (:import [java.util Arrays]
           [java.lang.management ManagementFactory MemoryNotificationInfo MemoryType MemoryPoolMXBean]
           [javax.management NotificationListener NotificationEmitter Notification]))

Non-nil means loading Lisp code in order to dump an executable. This means that certain objects should be allocated in shared (pure) space. It can also be set to a hash-table, in which case this table is used to do hash-consing of the objects allocated to pure space.

(defvar purify-flag nil)

Number of cons cells that have been consed so far.

(defvar cons-cells-consed nil)

Number of symbols that have been consed so far.

(defvar symbols-consed nil)

Hook run after garbage collection has finished.

(defvar post-gc-hook nil)

*Portion of the heap used for allocation. Garbage collection can happen automatically once this portion of the heap has been allocated since the last garbage collection. If this portion is smaller than `gc-cons-threshold', this is ignored.

(defvar gc-cons-percentage nil)

Accumulated number of garbage collections done.

(defvar gcs-done nil)

Accumulated time elapsed in garbage collections. The time is in seconds as a floating point value.

(defvar gc-elapsed nil)

*Number of bytes of consing between garbage collections. Garbage collection can happen automatically once this many bytes have been allocated since the last garbage collection. All data types count.

Garbage collection happens automatically only when `eval' is called.

By binding this temporarily to a large number, you can effectively prevent garbage collection during a part of the program. See also `gc-cons-percentage'.

You can customize this variable.

(defvar gc-cons-threshold nil)

Precomputed `signal' argument for memory-full error.

(defvar memory-signal-data nil)

Number of string characters that have been consed so far.

(defvar string-chars-consed nil)

Non-nil means Emacs cannot get much more Lisp memory.

(defvar memory-full nil)

Number of vector cells that have been consed so far.

(defvar vector-cells-consed nil)

Number of miscellaneous objects that have been consed so far. These include markers and overlays, plus certain objects not visible to users.

(defvar misc-objects-consed nil)

Non-nil means display messages at start and end of garbage collection.

You can customize this variable.

(defvar garbage-collection-messages nil)

Number of bytes of shareable Lisp data allocated so far.

(defvar pure-bytes-used nil)

Number of intervals that have been consed so far.

(defvar intervals-consed nil)

Number of strings that have been consed so far.

(defvar strings-consed nil)

Number of floats that have been consed so far.

(defvar floats-consed nil)

From http://www.javaspecialists.eu/archive/Issue092.html

(let [^MemoryPoolMXBean tenured-gen-pool (->> (ManagementFactory/getMemoryPoolMXBeans)
                                              (filter (fn [^MemoryPoolMXBean mb]
                                                        (and (= (.getType mb) MemoryType/HEAP) (.isUsageThresholdSupported mb))))
                                              first)
      warning-level 0.8]
  (.setUsageThreshold tenured-gen-pool
                      (long (* warning-level (.getMax (.getUsage tenured-gen-pool)))))
  (.addNotificationListener ^NotificationEmitter (ManagementFactory/getMemoryMXBean)
                            (proxy [NotificationListener] []
                              (handleNotification [^Notification n hb]
                                (when (= (.getType n) MemoryNotificationInfo/MEMORY_THRESHOLD_EXCEEDED)
                                  (el/setq memory-full true)))) nil nil))

Return a new bool-vector of length LENGTH, using INIT for each element. LENGTH must be a number. INIT matters only in whether it is t or nil.

(defun make-bool-vector (length init))

Create a byte-code object with specified arguments as elements. The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, and (optional) INTERACTIVE-SPEC. The first four arguments are required; at most six have any significance. The ARGLIST can be either like the one of `lambda', in which case the arguments will be dynamically bound before executing the byte code, or it can be an integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number of arguments (ignoring &rest) and the R bit specifies whether there is a &rest argument to catch the left-over arguments. If such an integer is used, the arguments will not be dynamically bound but will be instead pushed on the stack before executing the byte-code.

(defun make-byte-code (arglist byte-code constants depth &optional docstring interactive-spec &rest elements))

Return a list of counters that measure how much consing there has been. Each of these counters increments for a certain kind of object. The counters wrap around from the largest positive integer to zero. Garbage collection does not decrease them. The elements of the value are as follows: (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS) All are in units of 1 = one object consed except for VECTOR-CELLS and STRING-CHARS, which count the total length of objects consed. MISCS include overlays, markers, and some internal types. Frames, windows, buffers, and subprocesses count as vectors (but the contents of a buffer's text do not count here).

(defun memory-use-counts ())

Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed.

(defun vector (&rest objects)
  (object-array objects))

Concatenate all the argument characters and make the result a string.

(defun string (&rest characters)
  ;; Guard against interning as we allow modifications of String.value for now.
  (apply str characters))

Return a newly allocated marker which does not point at any place.

(defun make-marker ()
  ((ns-resolve 'deuce.emacs.buffer 'allocate-marker) nil nil nil))
(declare list)

Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than `gc-cons-threshold' bytes of Lisp data since previous garbage collection. `garbage-collect' normally returns a list with info on amount of space in use: ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS) (USED-MISCS . FREE-MISCS) USED-STRING-CHARS USED-VECTOR-SLOTS (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS) (USED-STRINGS . FREE-STRINGS)) However, if there was overflow in pure space, `garbage-collect' returns nil, because real GC can't be done. See Info node `(elisp)Garbage Collection'.

(defun garbage-collect ()
  (interactive)
  (System/gc)
  '(()))

Create a new cons, give it CAR and CDR as components, and return it.

(defun cons (car cdr)
  (cons/pair (cons/maybe-seq car) (cons/maybe-seq cdr)))

Return t if first arg is not equal to second arg. Both must be numbers or markers.

(defun #el/sym "/=" (num1 num2)
  (not ((ns-resolve 'deuce.emacs.data '=) num1 num2)))

Return a newly allocated uninterned symbol whose name is NAME. Its value and function definition are void, and its property list is nil.

(defun make-symbol (name)
  (symbol name))

Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. Does not copy symbols. Copies strings without text properties.

(defun purecopy (obj)
  (cons/maybe-seq obj))

Return the address of the last byte Emacs has allocated, divided by 1024. This may be helpful in debugging Emacs's memory usage. We divide the value by 1024 to make sure it fits in a Lisp integer.

(defun memory-limit ()
  (/ (.maxMemory (Runtime/getRuntime)) 1024))

Return a newly created vector of length LENGTH, with each element being INIT. See also the function `vector'.

(defun make-vector (length init)
  (doto (object-array length)
    (Arrays/fill init)))

Return a newly created string of length LENGTH, with INIT in each element. LENGTH must be an integer. INIT must be an integer that represents a character.

(defun make-string (length init)
  (apply str (repeat length (char init))))

Return a newly created list of length LENGTH, with each element being INIT.

(defun make-list (length init)
  (apply list (repeat length init)))

Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed.

(defun list (&rest objects)
  (apply cons/list objects))
 
(ns deuce.emacs.term
  (:use [deuce.emacs-lisp :only (defun defvar)])
  (:require [clojure.core :as c]
            [deuce.emacs.data :as data]
            [deuce.emacs.eval :as eval]
            [deuce.emacs.terminal :as terminal])
  (:import [com.googlecode.lanterna.screen Screen])
  (:refer-clojure :exclude []))

Functions to be run after suspending a tty. The functions are run with one argument, the terminal object to be suspended. See `suspend-tty'.

(defvar suspend-tty-functions nil)

Functions to be run after resuming a tty. The functions are run with one argument, the terminal object that was revived. See `resume-tty'.

(defvar resume-tty-functions nil)

Non-nil means to make the cursor very visible. This only has an effect when running in a text terminal. What means "very visible" is up to your terminal. It may make the cursor bigger, or it may make it blink, or it may do nothing at all.

You can customize this variable.

(defvar visible-cursor nil)

Non-nil means the system uses terminfo rather than termcap. This variable can be used by terminal emulator packages.

(defvar system-uses-terminfo nil)

Return non-nil if TERMINAL is the controlling tty of the Emacs process.

TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal). This function always returns nil if TERMINAL is not on a tty device.

(defun controlling-tty-p (&optional terminal)
  true)

Return non-nil if the tty device TERMINAL can display colors.

TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal). This function always returns nil if TERMINAL does not refer to a text-only terminal.

(defun tty-display-color-p (&optional terminal)
  true)

Declare that the tty used by TERMINAL does not handle underlining. This is used to override the terminfo data, for certain terminals that do not really do underlining, but say that they do. This function has no effect if used on a non-tty terminal.

TERMINAL can be a terminal object, a frame or nil (meaning the selected frame's terminal). This function always returns nil if TERMINAL does not refer to a text-only terminal.

(defun tty-no-underline (&optional terminal))

Return the type of the tty device that TERMINAL uses. Returns nil if TERMINAL is not on a tty device.

TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal).

(defun tty-type (&optional terminal)
  "lanterna")

Return the number of colors supported by the tty device TERMINAL.

TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal). This function always returns 0 if TERMINAL does not refer to a text-only terminal.

(defun tty-display-color-cells (&optional terminal)
  ({"xterm-256color" 256} (System/getenv "TERM") 16))

Resume the previously suspended terminal device TTY. The terminal is opened and reinitialized. Frames that are on the suspended terminal are revived.

It is an error to resume a terminal while another terminal is active on the same device.

This function runs `resume-tty-functions' after resuming the terminal. The functions are run with one arg, the id of the resumed terminal device.

`resume-tty' does nothing if it is called on a device that is not suspended.

TTY may be a terminal object, a frame, or nil (meaning the selected frame's terminal).

(defun resume-tty (&optional tty)
  (when-let [terminal ^Screen (terminal/frame-terminal)]
    (.startScreen terminal)
    ((ns-resolve 'deuce.main 'start-ui))
    (eval/run-hook-with-args 'resume-tty-functions terminal)))

Suspend the terminal device TTY.

The device is restored to its default state, and Emacs ceases all access to the tty device. Frames that use the device are not deleted, but input is not read from them and if they change, their display is not updated.

TTY may be a terminal object, a frame, or nil for the terminal device of the currently selected frame.

This function runs `suspend-tty-functions' after suspending the device. The functions are run with one arg, the id of the suspended terminal device.

`suspend-tty' does nothing if it is called on a device that is already suspended.

A suspended tty may be resumed by calling `resume-tty' on it.

(defun suspend-tty (&optional tty)
  (when-let [terminal ^Screen (terminal/frame-terminal)]
    ((ns-resolve 'deuce.main 'stop-ui))
    (.stopScreen terminal)
    (eval/run-hook-with-args 'suspend-tty-functions terminal)))
 
(ns deuce.emacs.emacs
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.fns :as fns]
            [deuce.emacs.terminal :as terminal]
            [deuce.emacs-lisp.globals :as globals])
  (:import [java.io File])
  (:refer-clojure :exclude []))

Version numbers of this version of Emacs.

(defvar emacs-version "24.2")

Non-nil means Emacs is running without interactive terminal.

(defvar noninteractive nil)

A directory within which to look for the lib-src' andetc' directories. In an installed Emacs, this is normally nil. It is non-nil if both lib-src' (on MS-DOS,info') and `etc' directories are found within the variable `invocation-directory' or its parent. For example, this is the case when running an uninstalled Emacs executable from its build directory.

(defvar installation-directory nil)

The directory in which the Emacs executable was found, to run it. The value is nil if that directory's name is not known.

(defvar invocation-directory nil)

Most recently used system locale for messages.

(defvar previous-system-messages-locale nil)

The value is a symbol indicating the type of operating system you are using. Special values: `gnu' compiled for a GNU Hurd system. `gnu/linux' compiled for a GNU/Linux system. `gnu/kfreebsd' compiled for a GNU system with a FreeBSD kernel. `darwin' compiled for Darwin (GNU-Darwin, Mac OS X, ...). `ms-dos' compiled as an MS-DOS application. `windows-nt' compiled as a native W32 application. `cygwin' compiled using the Cygwin library. Anything else (in Emacs 24.1, the possibilities are: aix, berkeley-unix, hpux, irix, usg-unix-v) indicates some sort of Unix system.

(defvar system-type (symbol "jvm"))

If non-nil, X resources, Windows Registry settings, and NS defaults are not used.

(defvar inhibit-x-resources nil)

String containing the configuration options Emacs was built with.

(defvar system-configuration-options nil)

Args passed by shell to Emacs, as a list of strings. Many arguments are deleted from the list as they are processed.

(defvar command-line-args (alloc/list "src/bootstrap-emacs" "-no-init-file"))

The program name that was used to run Emacs. Any directory names are omitted.

(defvar invocation-name nil)

System locale for messages.

(defvar system-messages-locale nil)

Alist of dynamic libraries vs external files implementing them. Each element is a list (LIBRARY FILE...), where the car is a symbol representing a supported external library, and the rest are strings giving alternate filenames for that library.

Emacs tries to load the library from the files in the order they appear on the list; if none is loaded, the running session of Emacs won't have access to that library.

Note that image types pbm' andxbm' do not need entries in this variable because they do not depend on external libraries and are always available.

Also note that this is not a generic facility for accessing external libraries; only those already known by Emacs will be loaded.

(defvar dynamic-library-alist nil)
(fns/put 'dynamic-library-alist 'risky-local-variable true)

Short copyright string for this version of Emacs.

(defvar emacs-copyright "Copyright (C) 2012 Free Software Foundation, Inc.")

System locale for time.

(defvar system-time-locale nil)

String containing the character that separates directories in search paths, such as PATH and other similar environment variables.

(defvar path-separator File/pathSeparator)

Value is string indicating configuration Emacs was built for. On MS-Windows, the value reflects the OS flavor and version on which Emacs is running.

(defvar system-configuration (format "jvm-%s_clojure-%s"
                                     (System/getProperty "java.version")
                                     (clojure-version)))

Hook to be run when `kill-emacs' is called. Since `kill-emacs' may be invoked when the terminal is disconnected (or in other similar situations), functions placed on this hook should not expect to be able to interact with the user. To ask for confirmation, see `kill-emacs-query-functions' instead.

Before Emacs 24.1, the hook was not run in batch mode, i.e., if `noninteractive' was non-nil.

(defvar kill-emacs-hook nil)

Value of `current-time' before Emacs begins initialization.

(defvar before-init-time nil)

Value of `current-time' after loading the init files. This is nil during initialization.

(defvar after-init-time nil)

Most recently used system locale for time.

(defvar previous-system-time-locale nil)

Return the directory name in which the Emacs executable was located.

(defun invocation-directory ())

Return the program name that was used to run Emacs. Any directory names are omitted.

(defun invocation-name ())

Mark the Emacs daemon as being initialized. This finishes the daemonization process by doing the other half of detaching from the parent process and its tty file descriptors.

(defun daemon-initialized ()
  (el/throw 'error "This function can only be called if emacs is run as a daemon"))

Return non-nil if the current emacs process is a daemon. If the daemon was given a name argument, return that name.

(defun daemonp ()
  nil)

Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. If ARG is a string, stuff it as keyboard input.

This function is called upon receipt of the signals SIGTERM or SIGHUP, and upon SIGINT in batch mode.

The value of `kill-emacs-hook', if not void, is a list of functions (of no args), all of which are called before Emacs is actually killed.

(defun kill-emacs (&optional arg)
  (interactive "P")
  (doall (map #(%) globals/kill-emacs-hook))
  (terminal/delete-terminal)
  (System/exit (if (integer? arg) arg 0)))

Dump current state of Emacs into executable file FILENAME. Take symbols from SYMFILE (presumably the file you executed to run Emacs). This is used in the file `loadup.el' when building Emacs.

You must run Emacs in batch mode in order to dump it.

(defun dump-emacs (filename symfile))
 
(ns deuce.emacs.frame
  (:use [deuce.emacs-lisp :only (defun defvar) :as el])
  (:require [clojure.core :as c]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.buffer :as buffer]
            [deuce.emacs.data :as data]
            [deuce.emacs-lisp.cons :as cons]
            [deuce.emacs-lisp.globals :as globals])
  (:import [deuce.emacs.data Frame Window]
           [com.googlecode.lanterna.screen Screen])
  (:refer-clojure :exclude []))

Non-nil if Menu-Bar mode is enabled. See the command `menu-bar-mode' for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `menu-bar-mode'.

You can customize this variable.

(defvar menu-bar-mode true)

Functions to be run before deleting a frame. The functions are run with one arg, the frame to be deleted. See `delete-frame'.

Note that functions in this list may be called just before the frame is actually deleted, or some time later (or even both when an earlier function in delete-frame-functions' (indirectly) callsdelete-frame' recursively).

(defvar delete-frame-functions nil)

If non-nil, make pointer invisible while typing. The pointer becomes visible again when the mouse is moved.

You can customize this variable.

(defvar make-pointer-invisible nil)

Name of window system through which the selected frame is displayed. The value is a symbol: nil for a termcap frame (a character-only terminal), 'x' for an Emacs frame that is really an X window, 'w32' for an Emacs frame that is a window on MS-Windows display, 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 'pc' for a direct-write MS-DOS frame.

Use of this variable as a boolean is deprecated. Instead, use display-graphic-p' or any of the otherdisplay-*-p' predicates which report frame's specific UI-related capabilities.

(defvar window-system nil)

The initial frame-object, which represents Emacs's stdout.

(defvar terminal-frame nil)

Alist of default values for frame creation. These may be set in your init file, like this: (setq default-frame-alist '((width . 80) (height . 55) (menu-bar-lines . 1))) These override values given in window system configuration data, including X Windows' defaults database. For values specific to the first Emacs frame, see `initial-frame-alist'. For window-system specific values, see `window-system-default-frame-alist'. For values specific to the separate minibuffer frame, see `minibuffer-frame-alist'. The `menu-bar-lines' element of the list controls whether new frames have menu bars; `menu-bar-mode' works by altering this element. Setting this variable does not affect existing frames, only new ones.

You can customize this variable.

(defvar default-frame-alist nil)

Non-nil if window system changes focus when you move the mouse. You should set this variable to tell Emacs how your window manager handles focus, since there is no way in general for Emacs to find out automatically. See also `mouse-autoselect-window'.

You can customize this variable.

(defvar focus-follows-mouse nil)

If non-nil, clickable text is highlighted when mouse is over it. If the value is an integer, highlighting is only shown after moving the mouse, while keyboard input turns off the highlight even when the mouse is over the clickable text. However, the mouse shape still indicates when the mouse is over clickable text.

You can customize this variable.

(defvar mouse-highlight nil)

Non-nil if Tool-Bar mode is enabled. See the command `tool-bar-mode' for a description of this minor mode. Setting this variable directly does not take effect; either customize it (see the info node `Easy Customization') or call the function `tool-bar-mode'.

You can customize this variable.

(defvar tool-bar-mode nil)

If non-nil, function to transform normal value of `mouse-position'. `mouse-position' calls this function, passing its usual return value as argument, and returns whatever this function returns. This abnormal hook exists for the benefit of packages like `xt-mouse.el' which need to do mouse handling at the Lisp level.

(defvar mouse-position-function nil)

Default position of scroll bars on this window-system.

(defvar default-frame-scroll-bars 'right)

Minibufferless frames use this frame's minibuffer.

Emacs cannot create minibufferless frames unless this is set to an appropriate surrogate.

Emacs consults this variable only when creating minibufferless frames; once the frame is created, it sticks with its assigned minibuffer, no matter what this variable is set to. This means that this variable doesn't necessarily say anything meaningful about the current set of frames, or where the minibuffer is currently being displayed.

This variable is local to the current terminal and cannot be buffer-local.

(defvar default-minibuffer-frame globals/terminal-frame)
(defn ^:private make-initial-frame []
  (let [allocate-window (ns-resolve 'deuce.emacs.window 'allocate-window)
        root-window (allocate-window false nil 0 1 10 9)
        selected-window (atom root-window)
        minibuffer-window (allocate-window true nil 0 9 10 1)
        terminal (atom nil)]
    (reset! (.next ^Window root-window) minibuffer-window)
    (reset! (.prev ^Window minibuffer-window) root-window)
    (Frame. "F1" root-window selected-window minibuffer-window terminal)))
(declare selected-frame frame-pixel-width frame-pixel-height)

Delete FRAME, permanently eliminating it from use. FRAME defaults to the selected frame.

A frame may not be deleted if its minibuffer is used by other frames. Normally, you may not delete a frame if all other frames are invisible, but if the second optional argument FORCE is non-nil, you may do so.

This function runs `delete-frame-functions' before actually deleting the frame, unless the frame is a tooltip. The functions are run with one argument, the frame to be deleted.

(defun delete-frame (&optional frame force)
  (interactive))

Send FRAME to the back, so it is occluded by any frames that overlap it. If you don't specify a frame, the selected frame is used. If Emacs is displaying on an ordinary terminal or some other device which doesn't support multiple overlapping frames, this function does nothing.

(defun lower-frame (&optional frame)
  (interactive))

Bring FRAME to the front, so it occludes any frames it overlaps. If FRAME is invisible or iconified, make it visible. If you don't specify a frame, the selected frame is used. If Emacs is displaying on an ordinary terminal or some other device which doesn't support multiple overlapping frames, this function selects FRAME.

(defun raise-frame (&optional frame)
  (interactive))

Return the parameters-alist of frame FRAME. It is a list of elements of the form (PARM . VALUE), where PARM is a symbol. The meaningful PARMs depend on the kind of frame. If FRAME is omitted, return information on the currently selected frame.

(defun frame-parameters (&optional frame)
  (let [frame (el/check-type 'framep (or frame (selected-frame)))]
    (list (cons/pair 'width (frame-pixel-width frame))
          (cons/pair 'height (frame-pixel-height frame))
          (cons/pair 'name (.name ^Frame frame)))))

Return FRAME's value for parameter PARAMETER. If FRAME is nil, describe the currently selected frame.

(defun frame-parameter (frame parameter)
  ((el/fun 'assq) parameter (frame-parameters (or frame (selected-frame)))))

Return non-nil if OBJECT is a frame. Value is: t for a termcap frame (a character-only terminal), 'x' for an Emacs frame that is really an X window, 'w32' for an Emacs frame that is a window on MS-Windows display, 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 'pc' for a direct-write MS-DOS frame. See also `frame-live-p'.

(defun framep (object)
  (instance? Frame object))

Return t if FRAME is "visible" (actually in use for display). Return the symbol `icon' if FRAME is iconified or "minimized". Return nil if FRAME was made invisible, via `make-frame-invisible'. On graphical displays, invisible frames are not updated and are usually not displayed at all, even in a window system's "taskbar".

If FRAME is a text-only terminal frame, this always returns t. Such frames are always considered visible, whether or not they are currently being displayed on the terminal.

(defun frame-visible-p (frame)
  (framep frame))

Create an additional terminal frame, possibly on another terminal. This function takes one argument, an alist specifying frame parameters.

You can create multiple frames on a single text-only terminal, but only one of them (the selected terminal frame) is actually displayed.

In practice, generally you don't need to specify any parameters, except when you want to create a new frame on another terminal. In that case, the `tty' parameter specifies the device file to open, and the `tty-type' parameter specifies the terminal type. Example:

 (make-terminal-frame '((tty . "/dev/pts/5") (tty-type . "xterm")))

Note that changing the size of one terminal frame automatically affects all frames on the same terminal device.

(defun make-terminal-frame (parms))

Modify the parameters of frame FRAME according to ALIST. If FRAME is nil, it defaults to the selected frame. ALIST is an alist of parameters to change and their new values. Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol. The meaningful PARMs depend on the kind of frame. Undefined PARMs are ignored, but stored in the frame's parameter list so that `frame-parameters' will return them.

The value of frame parameter FOO can also be accessed as a frame-local binding for the variable FOO, if you have enabled such bindings for that variable with `make-variable-frame-local'. Note that this functionality is obsolete as of Emacs 22.2, and its use is not recommended. Explicitly check for a frame-parameter instead.

(defun modify-frame-parameters (frame alist))

Handle a switch-frame event EVENT. Switch-frame events are usually bound to this function. A switch-frame event tells Emacs that the window manager has requested that the user's events be directed to the frame mentioned in the event. This function selects the selected window of the frame of EVENT.

If EVENT is frame object, handle it as if it were a switch-frame event to that frame.

(defun handle-switch-frame (event)
  (interactive "e"))

Make the frame FRAME visible (assuming it is an X window). If omitted, FRAME defaults to the currently selected frame.

(defun make-frame-visible (&optional frame)
  (interactive))

Return a list of all live frames.

(defun frame-list ()
  (alloc/list (selected-frame)))

Sets size of FRAME to COLS by ROWS, measured in characters.

(defun set-frame-size (frame cols rows))

The name of the window system that FRAME is displaying through. The value is a symbol: nil for a termcap frame (a character-only terminal), 'x' for an Emacs frame that is really an X window, 'w32' for an Emacs frame that is a window on MS-Windows display, 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 'pc' for a direct-write MS-DOS frame.

FRAME defaults to the currently selected frame.

Use of this function as a predicate is deprecated. Instead, use display-graphic-p' or any of the otherdisplay-*-p' predicates which report frame's specific UI-related capabilities.

(defun window-system (&optional frame)
  nil)

Return the previous frame in the frame list before FRAME. It considers only frames on the same terminal as FRAME. By default, skip minibuffer-only frames. If omitted, FRAME defaults to the selected frame. If optional argument MINIFRAME is nil, exclude minibuffer-only frames. If MINIFRAME is a window, include only its own frame and any frame now using that window as the minibuffer. If MINIFRAME is `visible', include all visible frames. If MINIFRAME is 0, include all visible and iconified frames. Otherwise, include all frames.

(defun previous-frame (&optional frame miniframe))

Move the mouse pointer to pixel position (X,Y) in FRAME. The position is given in pixels, where (0, 0) is the upper-left corner of the frame, X is the horizontal offset, and Y is the vertical offset.

Note, this is a no-op for an X frame that is not visible. If you have just created a frame, you must wait for it to become visible before calling this function on it, like this. (while (not (frame-visible-p frame)) (sleep-for .5))

(defun set-mouse-pixel-position (frame x y))

Return a FRAME's height in pixels. If FRAME is omitted, the selected frame is used. The exact value of the result depends on the window-system and toolkit in use:

In the Gtk+ version of Emacs, it includes only any window (including the minibuffer or echo area), mode line, and header line. It does not include the tool bar or menu bar.

With the Motif or Lucid toolkits, it also includes the tool bar (but not the menu bar).

In a graphical version with no toolkit, it includes both the tool bar and menu bar.

For a text-only terminal, it includes the menu bar. In this case, the result is really in characters rather than pixels (i.e., is identical to `frame-height').

(defun frame-pixel-height (&optional frame)
  (let [^Frame frame (el/check-type 'framep (or frame (selected-frame)))]
    (if-let [s ^Screen @(.terminal frame)]
      (.getRows (.getTerminalSize s))
      0)))

Return non-nil if OBJECT is a frame which has not been deleted. Value is nil if OBJECT is not a live frame. If object is a live frame, the return value indicates what sort of terminal device it is displayed on. See the documentation of `framep' for possible return values.

(defun frame-live-p (object)
  (framep object))

Specify that the frame FRAME has COLS columns. Optional third arg non-nil means that redisplay should use COLS columns but that the idea of the actual width of the frame should not be changed.

(defun set-frame-width (frame cols &optional pretend))

Select FRAME. Subsequent editing commands apply to its selected window. Optional argument NORECORD means to neither change the order of recently selected windows nor the buffer list.

The selection of FRAME lasts until the next time the user does something to select a different frame, or until the next time this function is called. If you are using a window system, the previously selected frame may be restored as the selected frame when returning to the command loop, because it still may have the window system's input focus. On a text-only terminal, the next redisplay will display FRAME.

This function returns FRAME, or nil if FRAME has been deleted.

(defun select-frame (frame &optional norecord)
  (interactive "e"))

Return the next frame in the frame list after FRAME. It considers only frames on the same terminal as FRAME. By default, skip minibuffer-only frames. If omitted, FRAME defaults to the selected frame. If optional argument MINIFRAME is nil, exclude minibuffer-only frames. If MINIFRAME is a window, include only its own frame and any frame now using that window as the minibuffer. If MINIFRAME is `visible', include all visible frames. If MINIFRAME is 0, include all visible and iconified frames. Otherwise, include all frames.

(defun next-frame (&optional frame miniframe))

Return FRAME's width in pixels. For a terminal frame, the result really gives the width in characters. If FRAME is omitted, the selected frame is used.

(defun frame-pixel-width (&optional frame)
  (let [^Frame frame (el/check-type 'framep (or frame (selected-frame)))]
    (if-let [s ^Screen @(.terminal frame)]
      (.getColumns (.getTerminalSize s))
      0)))

Specify that the frame FRAME has LINES lines. Optional third arg non-nil means that redisplay should use LINES lines but that the idea of the actual height of the frame should not be changed.

(defun set-frame-height (frame lines &optional pretend))

Return the frame to which FRAME's keystrokes are currently being sent. This returns nil if FRAME's focus is not redirected. See `redirect-frame-focus'.

(defun frame-focus (frame))

Return t if the mouse pointer displayed on FRAME is visible. Otherwise it returns nil. FRAME omitted or nil means the selected frame. This is useful when `make-pointer-invisible' is set.

(defun frame-pointer-visible-p (&optional frame))

Sets position of FRAME in pixels to XOFFSET by YOFFSET. This is actually the position of the upper left corner of the frame. Negative values for XOFFSET or YOFFSET are interpreted relative to the rightmost or bottommost possible position (that stays within the screen).

(defun set-frame-position (frame xoffset yoffset))

Make the frame FRAME into an icon. If omitted, FRAME defaults to the currently selected frame.

(defun iconify-frame (&optional frame)
  (interactive))

Make the frame FRAME invisible. If omitted, FRAME defaults to the currently selected frame. On graphical displays, invisible frames are not updated and are usually not displayed at all, even in a window system's "taskbar".

Normally you may not make FRAME invisible if all other frames are invisible, but if the second optional argument FORCE is non-nil, you may do so.

This function has no effect on text-only terminal frames. Such frames are always considered visible, whether or not they are currently being displayed in the terminal.

(defun make-frame-invisible (&optional frame force)
  (interactive))

Width in pixels of characters in the font in frame FRAME. If FRAME is omitted, the selected frame is used. On a graphical screen, the width is the standard width of the default font. For a terminal screen, the value is always 1.

(defun frame-char-width (&optional frame)
  1)

Return a list (FRAME X . Y) giving the current mouse frame and position. The position is given in character cells, where (0, 0) is the upper-left corner of the frame, X is the horizontal offset, and Y is the vertical offset. If Emacs is running on a mouseless terminal or hasn't been programmed to read the mouse position, it returns the selected frame for FRAME and nil for X and Y. If mouse-position-function' is non-nil,mouse-position' calls it, passing the normal return value to that function as an argument, and returns whatever that function returns.

(defun mouse-position ())

Move the mouse pointer to the center of character cell (X,Y) in FRAME. Coordinates are relative to the frame, not a window, so the coordinates of the top left character in the frame may be nonzero due to left-hand scroll bars or the menu bar.

The position is given in character cells, where (0, 0) is the upper-left corner of the frame, X is the horizontal offset, and Y is the vertical offset.

This function is a no-op for an X frame that is not visible. If you have just created a frame, you must wait for it to become visible before calling this function on it, like this. (while (not (frame-visible-p frame)) (sleep-for .5))

(defun set-mouse-position (frame x y))

Return the frame that is now selected.

(defun selected-frame ()
  globals/terminal-frame)

Arrange for keystrokes typed at FRAME to be sent to FOCUS-FRAME. In other words, switch-frame events caused by events in FRAME will request a switch to FOCUS-FRAME, and `last-event-frame' will be FOCUS-FRAME after reading an event typed at FRAME.

If FOCUS-FRAME is omitted or nil, any existing redirection is canceled, and the frame again receives its own keystrokes.

Focus redirection is useful for temporarily redirecting keystrokes to a surrogate minibuffer frame when a frame doesn't have its own minibuffer window.

A frame's focus redirection can be changed by `select-frame'. If frame FOO is selected, and then a different frame BAR is selected, any frames redirecting their focus to FOO are shifted to redirect their focus to BAR. This allows focus redirection to work properly when the user switches from one frame to another using `select-window'.

This means that a frame whose focus is redirected to itself is treated differently from a frame whose focus is redirected to nil; the former is affected by `select-frame', while the latter is not.

The redirection lasts until `redirect-frame-focus' is called to change it.

(defun redirect-frame-focus (frame &optional focus-frame))

Return width in pixels of FRAME's tool bar. The result is greater than zero only when the tool bar is on the left or right side of FRAME. If FRAME is omitted, the selected frame is used.

(defun tool-bar-pixel-width (&optional frame))

Return a list of all frames now "visible" (being updated).

(defun visible-frame-list ()
  (frame-list))

Height in pixels of a line in the font in frame FRAME. If FRAME is omitted, the selected frame is used. For a terminal frame, the value is always 1.

(defun frame-char-height (&optional frame)
  1)

Return a list (FRAME X . Y) giving the current mouse frame and position. The position is given in pixel units, where (0, 0) is the upper-left corner of the frame, X is the horizontal offset, and Y is the vertical offset. If Emacs is running on a mouseless terminal or hasn't been programmed to read the mouse position, it returns the selected frame for FRAME and nil for X and Y.

(defun mouse-pixel-position ())
 
(ns deuce.emacs-lisp.globals
  (:refer-clojure :only []))
 
(ns deuce.emacs-lisp.printer
  (:require [clojure.java.io :as io]
            [clojure.string :as s]
            [fipp.edn :as fp-edn]
            [fipp.clojure :as fp]
            [deuce.emacs-lisp :as el]))
(def ^:dynamic *pretty-style* :el)
(extend-protocol fp/IPretty
  java.lang.Object
  (-pretty [x ctx]
    (binding [*print-dup* true]
      [:text (pr-str x)]))

  clojure.lang.ISeq
  (-pretty [s ctx]
    (if-let [pretty-special (get (:symbols ctx) (first s))]
      (pretty-special s ctx)
      (fp/list-group [:align (if (symbol? (first s)) 1 0) (interpose :line (map #(fp/pretty % ctx) s))]))))
(extend-protocol fp-edn/IPretty
  java.lang.Object
  (-pretty [x ctx]
    (binding [*print-dup* true]
      [:text (pr-str x)])))
(defn ^:private pretty-docstring [docstring ctx]
  (if (string? docstring)
    [:group
     (concat ["  \]
             (interpose :break (map #(let [[t s] (fp/-pretty % ctx)]
                                       [:text (subs s 1 (dec (count s)))])
                                    (s/split docstring #"\n")))
             ["\])]
    [(fp/pretty docstring ctx)]))
(defn ^:private pretty-defun [[head fn-name params & more] ctx]
  (let [[docstring body] (fp/maybe-a string? more)]
    (fp/list-group
     (fp/-pretty head ctx) " " (fp/pretty fn-name ctx) " " (fp/-pretty params (dissoc ctx :symbols))
     (when docstring [:group :break (pretty-docstring docstring ctx)])
     (when (or docstring (seq body)) :break)
     (fp/block (map #(fp/pretty % ctx) body)))))
(defn ^:private pretty-defvar [[head symbol & [initvalue docstring]] ctx]
  (fp/list-group
   (fp/-pretty head ctx) " " (fp/pretty symbol ctx) :line (fp/block [(fp/-pretty initvalue ctx)])
   (when docstring [:group :break (pretty-docstring docstring ctx)])))
(defn ^:private pretty-let [[head varlist & body :as form] ctx]
  (let [varlist (for [kv varlist]
                  (if-let [[k v] (and (seq? kv) kv)]
                    [:span "(" (fp/-pretty k (dissoc ctx :symbols)) " " [:align (fp/pretty v ctx)] ")"]
                    [:span (fp/-pretty kv (dissoc ctx :symbols))]))]
    (fp/list-group
     (fp/-pretty head ctx) " "
     [:group "(" [:align (interpose :break varlist)] ")"]
     (when (seq body) :break)
     (fp/block (map #(fp/pretty % ctx) body)))))
(defn ^:private pretty-cond [[head & clauses] ctx]
  (let [clauses (for [c clauses]
                  [:group (concat [:span "(" (fp/-pretty (first c) ctx)]
                                  (when (> (count c) 1)
                                    [:span :line [:nest 1 (interpose :line (map #(fp/pretty % ctx) (rest c)))]])
                                  [")"])])]
    (fp/list-group
     (fp/-pretty head ctx) " "
     [:align (interpose :break clauses)])))
(defn ^:private pretty-if [[head cond then & else] ctx]
  (fp/list-group
   (fp/-pretty head ctx) " " (fp/pretty cond ctx) :line
   (fp/block [(fp/pretty then ctx)]) (when (seq else) :line)
   (fp/block (map #(fp/pretty % ctx) else))))
(defn ^:private pretty-block [break [head stmnt & block] ctx]
  (fp/list-group
   (fp/-pretty head ctx) " " (fp/pretty stmnt ctx) (when (seq block) break)
   (fp/block (map #(fp/pretty % ctx) block))))
(defn ^:private pretty-lambda [[head args & block] ctx]
  (fp/list-group
   (fp/-pretty head ctx) " " (fp/pretty args (dissoc ctx :symbols)) (when (seq block) :line)
   (fp/block (map #(fp/pretty % ctx) block))))
(defn ^:private pretty-quote [[macro arg] ctx]
  [:span "'" (fp-edn/pretty arg (dissoc ctx :symbols))])
(def ^:private el-symbols
  (fp/build-symbol-map
   {pretty-defun '[defmacro defun]
    pretty-defvar '[defvar defconst]
    pretty-let '[let let*]
    pretty-if '[deuce.emacs-lisp/if if]
    (partial pretty-block :line) '[setq set and or not]
    (partial pretty-block :break) '[while when unless dotimes dolist]
    pretty-lambda '[lambda closure]
    pretty-cond '[cond]
    pretty-quote '[quote]
    fp/pretty-ns '[ns]
    fp-edn/pretty '[#el/sym "\\`"]}))
(defn pprint-el
  ([form] (pprint-el form {}))
  ([form options]
   (fp/pprint form (merge {:symbols el-symbols :width 100} options))))
(defn write-clojure [el-form clj-file]
  (io/make-parents clj-file)
  (binding [*out* (io/writer clj-file)]
    (doseq [form (concat '[(ns deuce.emacs (:refer-clojure :only []))]
                         (map el/el->clj el-form))]
      (case *pretty-style*
        :edn (fp-edn/pprint form)
        :el (pprint-el form)
        (pr form))
      (println))
    (flush)))
 
(ns deuce.emacs-lisp.cons
  (:require [clojure.core :as c])
  (:refer-clojure :exclude [list cons])
  (:import [clojure.lang Seqable Sequential
            IPersistentCollection ISeq Cons
            IPersistentList PersistentList LazySeq]
           [java.io Writer]
           [java.lang.reflect Field]))
(defprotocol IList
  (car [this])
  (cdr [this]))
(defprotocol ICons
  (setcar [this val])
  (setcdr [this val]))
(extend-type nil
  IList
  (car [this] nil)
  (cdr [this] nil))
(def ^:private array-class (Class/forName "[Ljava.lang.Object;"))

(satisfies? IList object) is slow - not sure if I trust this old comment..

(defn listp [object]
  (or (nil? object) (and (sequential? object)
                         (not= array-class (type object)))))
(defn consp [object]
  (instance? PersistentList object))
(defn dotted-list? [x]
  (and (seq? x) (= '. (last (butlast x)))
       (listp (last x))))
(defn dotted-list-ending-in-pair? [x]
  (and (seq? x) (= '. (last (butlast x)))
       (not (listp (last x)))))
(defn dotted-pair? [x]
  (and (seq? x) (= 3 (count x)) (= '. (last (butlast x)))))
(extend-type IPersistentCollection
  IList
  (car [this] (first this))
  (cdr [this]
    (let [cdr (next this)]
      (if (= '. (first cdr))
        (second cdr)
        cdr))))
(defn field-accessor [prefix field class]
  (eval `(def ^{:private true :tag `Field}
           ~(symbol (str prefix (name field))) (doto (.getDeclaredField ~class ~(name field))
                                              (.setAccessible true)))))
(doseq [field '[_first _rest _count]]
  (field-accessor "l" field PersistentList))
(declare list)
(extend-type PersistentList
  ICons
  (setcar [^PersistentList this val]
    (do (.set ^Field l_first this val)
        val))
  (setcdr [^PersistentList this val]
    (if (or (instance? IPersistentList val) (nil? val) (= () val))
      (do
        (.set ^Field l_rest this val)
        (.set ^Field l_count this (int (inc (count val))))) ;; this gets out of sync when changing part of the tail.
      (if (dotted-pair? this)
        (setcar (rest (rest this)) val)
        (do
          (.set ^Field l_rest this (c/list '. val))
          (.set ^Field l_count this (int 3)))))
    val))

This should really be eval-expression-print-length, maybe move this to deuce.emacs.print There's also eval-expression-print-level which controls nesting. There's also print-level and print-lenght, seem to be nil in Emacs.

(def ^:private max-print-length 12)
(defn ellipsis [coll]
  (let [s (seq coll)]
    (seq (concat (doall (take max-print-length s))
                 (when (< max-print-length (count s))
                   ['...])))))
(defn print-list [c ^Writer w]
  (.write w "(")
  (loop [c c idx 1]
    (if (> idx max-print-length)
      (.write w "...)")
      (do
        (.write w (pr-str (car c)))
        (cond
         (not (listp (cdr c))) (.write w (str " . " (pr-str (cdr c)) ")"))
         (seq (cdr c)) (do
                         (.write w " ")
                         (recur (cdr c) (inc idx)))
         :else (.write w ")"))))))

(defmethod print-method PersistentList [c ^Writer w] (print-list c w))

(defmethod print-method Cons [c ^Writer w] (print-list c w))

(defn pair [car cdr]
  (if (listp cdr)
    (doto (c/list car)
      (setcdr cdr))
    (c/list car '. cdr)))

Fix uses of (apply cons/list ...) to something saner

(defn list [& objects]
  (when (seq objects)
    (pair (car objects)
          (apply list (cdr objects)))))
(defn last-cons [l]
  (if (not (consp (cdr l))) l (recur (cdr l))))

Figure out where this is actually needed.

(defn maybe-seq [x]
  (if (and (seq? x)
;           (not (dotted-pair? x))
           (not (consp x)))
    (if (dotted-list-ending-in-pair? x)
      (apply c/list x)
      (apply list x))
    x))
 
(ns deuce.emacs-lisp.parser
  (:require [clojure.walk :as w]
            [clojure.string :as s]
            [clojure.pprint :as pp]
            [deuce.emacs-lisp :as el]
            [deuce.emacs-lisp.cons :refer [car cdr] :as cons]
            [deuce.emacs.alloc :as alloc]
            [deuce.emacs.casefiddle :as casefiddle]
            [deuce.emacs.textprop :as textprop])
  (:import [java.io InputStream]
           [java.lang.reflect Field]
           [java.util Scanner]
           [java.util.regex Pattern]))
(declare tokenize)
(def character-modifier-symbols '{"\\A" alt "\\s" super "\\H" hyper
                                  "\\S" shift "\\C" control "\\M" meta})
(def character-modifier-bits '{alt 0x0400000
                               super 0x0800000
                               hyper 0x1000000
                               shift 0x2000000
                               control 0x4000000
                               meta 0x8000000})

In theory escape characters in strings should be escaped inside Emacs strings somewhat like this:

(defn ^:private parse-control-char [maybe-control & [for-string?]]
  (cond
   (> maybe-control 127) (when for-string?
                           (char (- maybe-control 96)))
   (= (int \?) maybe-control) \ ;; DEL
   ;; This case results in a normal xor modifier in event-convert-list-internal by returning nul.
   (or (> (int \?)  maybe-control (int \space))
       (>=  maybe-control (int \{))
       (#{\tab \return \newline} (char maybe-control)))
   (when for-string? (el/throw* 'error "Invalid modifier in string"))
   :else (char (mod maybe-control 32))))

See http://www.gnu.org/software/emacs/manual/html_node/elisp/Nonprinting-Characters.html

(defn resolve-control-chars [s]
  (-> s
      (s/replace #"\\d" "") ;; DEL
      (s/replace #"\\e" "") ;; ESC
      (s/replace #"\\s" " ")
      (s/replace #"\\t" "\t")
      (s/replace #"(?s)\\+(?:C-|\^)(\\?.)" ;; Optional backslash handling somewhat confusing.
                 (fn [[control base]]
                   (if (re-find #"^\\\\" control) ;; Can be a quoted control char
                     control
                     (str (parse-control-char (int (last base)) :for-string)))))
      (s/replace #"\\M-(\\?.)"   ;; "\M-i" converts into "�". This only works for 7-bit ASCII.
                 (fn [[meta base]]
                   (let [c (int (last base))]
                     (if (< c 128)
                       (str (char (bit-xor 128 c)))
                       (el/throw* 'error "Invalid modifier in string")))))))

This takes an actual quoted String. Can easiest be called from the REPL by chaining (pr-str "...")

(defn ^:private parse-string [s]
  (reduce (fn [s [m r]] (s/replace s m r))
          (subs s 1 (dec (count s)))
          [["\\\n" ]
           ["\\\ "\]
           ["\\\\" "\\"]
           [#"\\(\d+)" (fn [[_ n]]
                         (str (char (Integer/parseInt n 8))))]
           [#"\\x(\p{XDigit}+)" (fn [[_ n]]
                                  (str (char (Integer/parseInt n 16))))]
           ["\\n" "\n"]
           ["\\r" "\r"]
           ["\\b" "\b"]
           ["\\t" "\t"]]))

Like Emacs, certain characters can be read both with single and double backslash. Not necessarily the same ones.

(def emacs-problem-chars {"\\" \\ "\\s" \space
                          "\\-" \- "-" \- "\ \"})

Various ctrl-characters are broken, many ways they can be specified, this simplified take doesn't fit the Emacs model. Should be rewritten with some thought behind it. Maybe a test. http://www.gnu.org/software/emacs/manual/html_node/elisp/Character-Type.html doesn't really cover it in all it's glory. Looks like edmacro/edmacro-parse-keys actually contains a lot of the logic.

Here's an attempt at doing something more correct, see deuce.emacs.keyboard/event-convert-list:

(defn event-convert-list-internal [mods base & [no-modifier-conversion]]    ;; no-modifiers-conversion is used when parsing chars.
  (let [[mods base] [(set mods) (int base)]
        [mods base] (if-let [control-char (and (mods 'control)              ;; This turns '(control \space) into 0: "\^@"
                                               (and (not (<= (int base) (int \space)))
                                                    no-modifier-conversion) ;; Don't reparse actual lower control characters.
                                               (parse-control-char base))]
                      [(disj (if (and (not no-modifier-conversion)          ;; It is a valid 5 bit or 127 control char
                                      (Character/isUpperCase (char base)))  ;; Remove control modifier as its baked in.
                               (conj mods 'shift)                           ;; If original was upper case, add shift modifier
                               mods) 'control) (int control-char)]
                      [mods base])
        [mods base] (if (and (mods 'shift) (not no-modifier-conversion)     ;; Turns '(shift \a) into \A
                             (Character/isLowerCase (char base))            ;; If and only if a 7 bit ASCII char, upper case it
                             (< base 128))
                      [(disj mods 'shift) (casefiddle/upcase base)]         ;; Remove shift modifier as its baked in.
                      [mods base])]                                         ;; (But upper case characters can have 'shift as well.)
    (reduce bit-xor base (replace character-modifier-bits mods))))          ;; XOR in the modifiers.

XOR in the modifiers.

Takes an Emacs-style charcter specifier without the leading ? Turns "C-a" into \ Returns characters for things that fit below Character/MAX_VALUE, otherwise ints. We may want our own real type for this. It parses the base character as a string first.

(defn ^:private parse-character [c]
  (if-let [c (emacs-problem-chars c)]
    c
    (let [parts  (if (re-find #".+--$" c)
                   (vec (concat (s/split c #"-") ["-"]))
                   (s/split c #"-"))
          [mods c] [(set (butlast parts)) (last parts)]
          c (cond
             (character-modifier-symbols c) -1
             (re-find #"\\\d+" c) (Integer/parseInt (subs c 1) 8)
             (re-find #"\\x\p{XDigit}+" c) (Integer/parseInt (subs c 2) 16)
             :else (int (first (resolve-control-chars (parse-string (str \" c \"))))))]
      (if (= -1 c) c
          (let [c (event-convert-list-internal
                   (replace character-modifier-symbols mods) c :no-modifier-conversion)]
            (if (<= c (int (Character/MAX_VALUE)))
              (char c)
              (long c)))))))
(defn ^:private strip-comments [form]
  (remove (every-pred seq? (comp `#{comment} first)) form))
(defn ^:private as-vector [form]
  (object-array (vec form)))
(def ^:private ^Pattern re-str #"(?s)([^\"\\]*(?:\\.[^\"\\]*)*)\)
(def ^:private ^Pattern re-char #"(?s)((\\[CSMAHs]-)*(\\x?\p{XDigit}+|(\\\^?)?.))")
(defn parse-characters [s meta-prefix-char]
  (seq (map (comp parse-character first)
            (re-seq re-char (resolve-control-chars (s/replace s "\\M-" (str (char meta-prefix-char))))))))
(def ^:private unmodifiers (zipmap (vals character-modifier-bits) (keys character-modifier-bits)))

Turns #el/vec [67108911] into '(control \/), not sure how to read them from keyboard using lanterna.

(defn unmodify-key [k]
  (let [keys (reduce
              (fn [[key & modifiers :as k] modifier]
                (if (> (bit-and key modifier) 0)
                  (cons (bit-and-not key modifier)
                        (cons (unmodifiers modifier) modifiers))
                  k)) k (keys unmodifiers))]
    (reverse (cons (char (first keys)) (rest keys)))))
(defn ^:private tokenize-all [^Scanner sc]
  (strip-comments (take-while (complement #{`end}) (repeatedly (partial tokenize sc)))))
(defn ^:private tokenize [^Scanner sc]
  (let [find (fn [^Pattern re h] (.findWithinHorizon sc re (int h)))]
    (condp find 1
      #"\s" (recur sc)
      #"[)\]]" `end
      #"\(" (tokenize-all sc)
      #"\[" (as-vector (tokenize-all sc))
      #"," (list (if (find #"@" 1) '#el/sym "\\,@" '#el/sym "\\,") (tokenize sc))
      #"'" (list 'quote (tokenize sc))
      #"`" (let [form  (tokenize sc)]
             (if (symbol? form)
               (list 'quote form)
               (list '#el/sym "\\`" form)))
      #":" (keyword (.next sc))
      #"\?" (parse-character (find re-char 0))
      #"\ (parse-string (str \" (find re-str 0)))
      ;; Deal with: ;;; -*- lexical-binding: t -*- or autoload      ;;;###autoload      ;;; Code
      #";" (list `comment (.nextLine sc))
      #"#" (condp find 1
             ;; #"^" is a CharTable looking like this: #^[nil nil keymap ...]
             #"'" (list 'function (tokenize sc))
             #"\(" (let [[object start end properties] (tokenize-all sc)]
                     (list `textprop/set-text-properties start end properties object))
             #"x" (.nextInt sc (int 16))
             #"o" (.nextInt sc (int 8))
             #"b" (.nextInt sc (int 2))
             (when (.hasNext sc #"\d+r\S+")
               (let [radix (find #"\d+" 0)]
                 (find #"r" 1)
                 (.nextInt sc (Integer/parseInt radix)))))
      (cond
       (.hasNextLong sc) (.nextLong sc)
       (.hasNextDouble sc) (.nextDouble sc)
       (.hasNext sc) (let [s (find #"[^\s\[\]\(\)\"\;]+" 0)]
                       (case s
                         "t" true
                         "nil" nil
                         (symbol nil s)))
       :else `end))))
(def scanner-position (doto (.getDeclaredField Scanner "position")
                        (.setAccessible true)))
(defn parse-internal [r & [all?]]
  (let [scanner (doto (if (string? r) (Scanner. ^String r) (Scanner. ^InputStream r "UTF-8"))
                  (.useDelimiter #"(\s|\]|\)|\"|;)"))]
    (cons/pair
     ((if all? tokenize-all tokenize) scanner)
     (.get ^Field scanner-position scanner))))
(defn parse [r]
  (cons/car (parse-internal r :all)))
 
(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]))
(setq t true)

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")

(({"English" {(quote tutorial) "TUTORIAL"}} lang-env {}) key)

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

(symbol-value ({0 (quote eol-mnemonic-unix), 1 (quote eol-mnemonic-dos), 2 (quote eol-mnemonic-mac)} (coding-system-eol-type coding-system) (quote eol-mnemonic-undecided)))

(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)))

I'm the one and only Frame

(setq terminal-frame ((c/ns-resolve 'deuce.emacs.frame 'make-initial-frame)))
(setq last-event-frame terminal-frame)

(c/require (quote deuce.main))

Callback run by faces/tty-run-terminal-initialization based on deuce.emacs.term/tty-type returning "lanterna"

(defun terminal-init-lanterna ()
  (c/require 'deuce.main)
  ((c/ns-resolve 'deuce.main 'terminal-init-lanterna)))

Create Deuce log buffer first so it won't get selected.

(get-buffer-create "*Deuce*")

Messages is created by xdisp.c

(get-buffer-create "*Messages*")

scratch is created by buffer.c

(set-window-buffer (selected-window)
                   (get-buffer-create "*scratch*"))

Minibuffer 0 is the empty one, this is either created by frame.c or minibuffer.c Not the leading space for buffers in the minibuffer window. Minibuf-1 etc. gets created once it gets activated. You can switch to these buffers in a normal window in Emacs and see them change as they're used.

(set-window-buffer (minibuffer-window)
                   (get-buffer-create " *Minibuf-0*"))

ensureechoarea_buffers in xdisp.c creates (at least) two echo areas.

(get-buffer-create " *Echo Area 0*")
(get-buffer-create " *Echo Area 1*")

Hack for a predicate in cl.el, this is defined in emacs-lisp/bytecomp.el, which we're not using

(defun byte-compile-file-form (form))

AOT cl.el gets confused by this alias

(defalias 'cl-block-wrapper 'identity)
(defmacro declare (&rest _specs) nil)

with-no-warnings in byte-run.el needs this

(defun last (list &optional n))

subr defines a simpler dolist, which custom uses, which gets redefined by cl-macs. During AOT custom loads the latter dolist definition, requiring 'block' - not yet defined. cl cannot be loaded first, as it depends on help-fns, which depend on custom.

(defmacro block (name &rest body) (cons 'progn body))

Hack as delayed-eval doesn't (like some other things) work properly inside let-bindings. Needs to be fixed properly, but let's see if we can get through the boot with this hack. cl-setf-simple-store-p is used in cl-macs/cl-setf-do-modify, delayed-eval call refers to earlier binding 'method'.

(defun cl-setf-simple-store-p (sym form))

Same issue in regexp-opt/regexp-opt. Calls this fn with earlier binding 'sorted-strings'

(defun regexp-opt-group (strings &optional paren lax))

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))

\e

Main prefix keymaps setup from keymap.c

\C-x

(define-key globals/global-map "\\e" 'ESC-prefix)
(define-key globals/global-map "\\C-x" 'Control-X-prefix)

\C-i

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))

b

buffer commands from buffer.c

k

(define-key globals/ctl-x-map  'switch-to-buffer)
(define-key globals/ctl-x-map  'kill-buffer)

\C-u

case commands from casefiddle.c

\C-l

(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)

u

l

c

(define-key globals/esc-map  'upcase-word)
(define-key globals/esc-map  'downcase-word)
(define-key globals/esc-map  'capitalize-word)

\C-a

basic movement commands setup in cmds.c

\C-b

\C-e

\C-f

(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)

\C-z

basic commands setup in keyboard.c

\C-z

\C-c

\C-]

x

(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  'execute-extended-command)

There's also a bunch of initialdefinelispy_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)

\C-v

\C-v

v

(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  '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)