sjs/config
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[CHANGED] Added json.el and made several improvements to mojo.el.

Browse source 
See changelog section in mojo.el for details.
This commit is contained in:
Sami Samhuri 2009-11-21 05:04:43 -08:00
parent f287b64e6e
commit bdb2acb15d
3 changed files with 898 additions and 123 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
emacs
View file

@ -140,6 +140,15 @@
(require 'mojo)
;;;;;;;;;;;;;;;;
;; javascript ;;
;;;;;;;;;;;;;;;;
(autoload 'js2-mode "js2-mode" nil t)
(add-to-list 'auto-mode-alist '("\\.js$" . js2-mode))
;;;;;;;;;;;;
;; markup ;;
;;;;;;;;;;;;
@ -168,11 +177,11 @@
(setq scheme-program-name "~/Projects/elschemo/elschemo")
;; setup slime
;; (require 'slime)
;; (add-hook 'lisp-mode-hook (lambda () (slime-mode t)))
;; (add-hook 'scheme-mode-hook (lambda () (slime-mode t)))
;; (add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode t)))
;; (add-hook 'inferior-scheme-mode-hook (lambda () (inferior-slime-mode t)))
;(require 'slime)
;(add-hook 'lisp-mode-hook (lambda () (slime-mode t)))
;(add-hook 'scheme-mode-hook (lambda () (slime-mode t)))
;(add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode t)))
;(add-hook 'inferior-scheme-mode-hook (lambda () (inferior-slime-mode t)))
;; use sbcl for lisp
(setq inferior-lisp-program "/usr/bin/sbcl")
@ -247,6 +256,12 @@
(global-set-key "<" 'tagify-region-or-insert-self)
(global-set-key "\C-zt" 'tagify-region-or-insert-tag)
;; mojo keyboard shortcuts
(global-set-key [f2] 'mojo-generate-scene)
(global-set-key [f3] 'mojo-emulate)
(global-set-key [f4] 'mojo-package)
(global-set-key [f5] 'mojo-package-install-and-inspect)
;; XXX:todo need a version of this that inserts a line terminator as well
;; Use C-j!
;;(global-set-key [M-return] 'move-end-of-line-insert-newline)
@ -374,6 +389,8 @@
'(face-font-family-alternatives (quote (("bistream vera sans mono" "courier" "fixed") ("helv" "helvetica" "arial" "fixed"))))
'(global-font-lock-mode t nil (font-lock))
'(icicle-reminder-prompt-flag 5)
'(mojo-build-directory "~/Projects/brighthouse/webOS/build")
'(mojo-project-directory "~/Projects/brighthouse/webOS")
'(remote-shell-program "/usr/bin/ssh")
'(save-place t nil (saveplace))
'(scroll-bar-mode nil)
@ -392,3 +409,9 @@
(put 'upcase-region 'disabled nil)
(put 'downcase-region 'disabled nil)
(custom-set-faces
;; custom-set-faces was added by Custom.
;; If you edit it by hand, you could mess it up, so be careful.
;; Your init file should contain only one such instance.
;; If there is more than one, they won't work right.
)

530
emacs.d/json.el Normal file
View file

@ -0,0 +1,530 @@
;;; json.el --- JavaScript Object Notation parser / generator
;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Edward O'Connor <ted@oconnor.cx>
;; Version: 1.2
;; Keywords: convenience
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is a library for parsing and generating JSON (JavaScript Object
;; Notation).
;; Learn all about JSON here: <URL:http://json.org/>.
;; The user-serviceable entry points for the parser are the functions
;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.
;; Since there are several natural representations of key-value pair
;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').
;; Similarly, since `false' and `null' are distinct in JSON, you can
;; distinguish them by binding `json-false' and `json-null' as desired.
;;; History:
;; 2006-03-11 - Initial version.
;; 2006-03-13 - Added JSON generation in addition to parsing. Various
;; other cleanups, bugfixes, and improvements.
;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
;; 2008-02-21 - Installed in GNU Emacs.
;;; Code:
(eval-when-compile (require 'cl))
;; Compatibility code
(defalias 'json-encode-char0 'encode-char)
(defalias 'json-decode-char0 'decode-char)
;; Parameters
(defvar json-object-type 'alist
"Type to convert JSON objects to.
Must be one of `alist', `plist', or `hash-table'. Consider let-binding
this around your call to `json-read' instead of `setq'ing it.")
(defvar json-array-type 'vector
"Type to convert JSON arrays to.
Must be one of `vector' or `list'. Consider let-binding this around
your call to `json-read' instead of `setq'ing it.")
(defvar json-key-type nil
"Type to convert JSON keys to.
Must be one of `string', `symbol', `keyword', or nil.
If nil, `json-read' will guess the type based on the value of
`json-object-type':
If `json-object-type' is: nil will be interpreted as:
`hash-table' `string'
`alist' `symbol'
`plist' `keyword'
Note that values other than `string' might behave strangely for
Sufficiently Weird keys. Consider let-binding this around your call to
`json-read' instead of `setq'ing it.")
(defvar json-false :json-false
"Value to use when reading JSON `false'.
If this has the same value as `json-null', you might not be able to tell
the difference between `false' and `null'. Consider let-binding this
around your call to `json-read' instead of `setq'ing it.")
(defvar json-null nil
"Value to use when reading JSON `null'.
If this has the same value as `json-false', you might not be able to
tell the difference between `false' and `null'. Consider let-binding
this around your call to `json-read' instead of `setq'ing it.")
;;; Utilities
(defun json-join (strings separator)
"Join STRINGS with SEPARATOR."
(mapconcat 'identity strings separator))
(defun json-alist-p (list)
"Non-null if and only if LIST is an alist."
(or (null list)
(and (consp (car list))
(json-alist-p (cdr list)))))
(defun json-plist-p (list)
"Non-null if and only if LIST is a plist."
(or (null list)
(and (keywordp (car list))
(consp (cdr list))
(json-plist-p (cddr list)))))
;; Reader utilities
(defsubst json-advance (&optional n)
"Skip past the following N characters."
(forward-char n))
(defsubst json-peek ()
"Return the character at point."
(let ((char (char-after (point))))
(or char :json-eof)))
(defsubst json-pop ()
"Advance past the character at point, returning it."
(let ((char (json-peek)))
(if (eq char :json-eof)
(signal 'end-of-file nil)
(json-advance)
char)))
(defun json-skip-whitespace ()
"Skip past the whitespace at point."
(skip-chars-forward "\t\r\n\f\b "))
;; Error conditions
(put 'json-error 'error-message "Unknown JSON error")
(put 'json-error 'error-conditions '(json-error error))
(put 'json-readtable-error 'error-message "JSON readtable error")
(put 'json-readtable-error 'error-conditions
'(json-readtable-error json-error error))
(put 'json-unknown-keyword 'error-message "Unrecognized keyword")
(put 'json-unknown-keyword 'error-conditions
'(json-unknown-keyword json-error error))
(put 'json-number-format 'error-message "Invalid number format")
(put 'json-number-format 'error-conditions
'(json-number-format json-error error))
(put 'json-string-escape 'error-message "Bad unicode escape")
(put 'json-string-escape 'error-conditions
'(json-string-escape json-error error))
(put 'json-string-format 'error-message "Bad string format")
(put 'json-string-format 'error-conditions
'(json-string-format json-error error))
(put 'json-object-format 'error-message "Bad JSON object")
(put 'json-object-format 'error-conditions
'(json-object-format json-error error))
;;; Keywords
(defvar json-keywords '("true" "false" "null")
"List of JSON keywords.")
;; Keyword parsing
(defun json-read-keyword (keyword)
"Read a JSON keyword at point.
KEYWORD is the keyword expected."
(unless (member keyword json-keywords)
(signal 'json-unknown-keyword (list keyword)))
(mapc (lambda (char)
(unless (char-equal char (json-peek))
(signal 'json-unknown-keyword
(list (save-excursion
(backward-word 1)
(thing-at-point 'word)))))
(json-advance))
keyword)
(unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
(signal 'json-unknown-keyword
(list (save-excursion
(backward-word 1)
(thing-at-point 'word)))))
(cond ((string-equal keyword "true") t)
((string-equal keyword "false") json-false)
((string-equal keyword "null") json-null)))
;; Keyword encoding
(defun json-encode-keyword (keyword)
"Encode KEYWORD as a JSON value."
(cond ((eq keyword t) "true")
((eq keyword json-false) "false")
((eq keyword json-null) "null")))
;;; Numbers
;; Number parsing
(defun json-read-number (&optional sign)
"Read the JSON number following point.
The optional SIGN argument is for internal use.
N.B.: Only numbers which can fit in Emacs Lisp's native number
representation will be parsed correctly."
;; If SIGN is non-nil, the number is explicitly signed.
(let ((number-regexp
"\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
(cond ((and (null sign) (char-equal (json-peek) ?-))
(json-advance)
(- (json-read-number t)))
((and (null sign) (char-equal (json-peek) ?+))
(json-advance)
(json-read-number t))
((and (looking-at number-regexp)
(or (match-beginning 1)
(match-beginning 2)))
(goto-char (match-end 0))
(string-to-number (match-string 0)))
(t (signal 'json-number-format (list (point)))))))
;; Number encoding
(defun json-encode-number (number)
"Return a JSON representation of NUMBER."
(format "%s" number))
;;; Strings
(defvar json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
(?/ . ?/)
(?b . ?\b)
(?f . ?\f)
(?n . ?\n)
(?r . ?\r)
(?t . ?\t))
"Characters which are escaped in JSON, with their elisp counterparts.")
;; String parsing
(defun json-read-escaped-char ()
"Read the JSON string escaped character at point."
;; Skip over the '\'
(json-advance)
(let* ((char (json-pop))
(special (assq char json-special-chars)))
(cond
(special (cdr special))
((not (eq char ?u)) char)
((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
(let ((hex (match-string 0)))
(json-advance 4)
(json-decode-char0 'ucs (string-to-number hex 16))))
(t
(signal 'json-string-escape (list (point)))))))
(defun json-read-string ()
"Read the JSON string at point."
(unless (char-equal (json-peek) ?\")
(signal 'json-string-format (list "doesn't start with '\"'!")))
;; Skip over the '"'
(json-advance)
(let ((characters '())
(char (json-peek)))
(while (not (char-equal char ?\"))
(push (if (char-equal char ?\\)
(json-read-escaped-char)
(json-pop))
characters)
(setq char (json-peek)))
;; Skip over the '"'
(json-advance)
(if characters
(apply 'string (nreverse characters))
"")))
;; String encoding
(defun json-encode-char (char)
"Encode CHAR as a JSON string."
(setq char (json-encode-char0 char 'ucs))
(let ((control-char (car (rassoc char json-special-chars))))
(cond
;; Special JSON character (\n, \r, etc.)
(control-char
(format "\\%c" control-char))
;; ASCIIish printable character
((and (> char 31) (< char 161))
(format "%c" char))
;; Fallback: UCS code point in \uNNNN form
(t
(format "\\u%04x" char)))))
(defun json-encode-string (string)
"Return a JSON representation of STRING."
(format "\"%s\"" (mapconcat 'json-encode-char string "")))
;;; JSON Objects
(defun json-new-object ()
"Create a new Elisp object corresponding to a JSON object.
Please see the documentation of `json-object-type'."
(cond ((eq json-object-type 'hash-table)
(make-hash-table :test 'equal))
(t
(list))))
(defun json-add-to-object (object key value)
"Add a new KEY -> VALUE association to OBJECT.
Returns the updated object, which you should save, e.g.:
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
(let ((json-key-type
(if (eq json-key-type nil)
(cdr (assq json-object-type '((hash-table . string)
(alist . symbol)
(plist . keyword))))
json-key-type)))
(setq key
(cond ((eq json-key-type 'string)
key)
((eq json-key-type 'symbol)
(intern key))
((eq json-key-type 'keyword)
(intern (concat ":" key)))))
(cond ((eq json-object-type 'hash-table)
(puthash key value object)
object)
((eq json-object-type 'alist)
(cons (cons key value) object))
((eq json-object-type 'plist)
(cons key (cons value object))))))
;; JSON object parsing
(defun json-read-object ()
"Read the JSON object at point."
;; Skip over the "{"
(json-advance)
(json-skip-whitespace)
;; read key/value pairs until "}"
(let ((elements (json-new-object))
key value)
(while (not (char-equal (json-peek) ?}))
(json-skip-whitespace)
(setq key (json-read-string))
(json-skip-whitespace)
(if (char-equal (json-peek) ?:)
(json-advance)
(signal 'json-object-format (list ":" (json-peek))))
(setq value (json-read))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
(unless (char-equal (json-peek) ?})
(if (char-equal (json-peek) ?,)
(json-advance)
(signal 'json-object-format (list "," (json-peek))))))
;; Skip over the "}"
(json-advance)
elements))
;; Hash table encoding
(defun json-encode-hash-table (hash-table)
"Return a JSON representation of HASH-TABLE."
(format "{%s}"
(json-join
(let (r)
(maphash
(lambda (k v)
(push (format "%s:%s"
(json-encode k)
(json-encode v))
r))
hash-table)
r)
", ")))
;; List encoding (including alists and plists)
(defun json-encode-alist (alist)
"Return a JSON representation of ALIST."
(format "{%s}"
(json-join (mapcar (lambda (cons)
(format "%s:%s"
(json-encode (car cons))
(json-encode (cdr cons))))
alist)
", ")))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
(let (result)
(while plist
(push (concat (json-encode (car plist))
":"
(json-encode (cadr plist)))
result)
(setq plist (cddr plist)))
(concat "{" (json-join (nreverse result) ", ") "}")))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
Tries to DWIM: simple lists become JSON arrays, while alists and plists
become JSON objects."
(cond ((null list) "null")
((json-alist-p list) (json-encode-alist list))
((json-plist-p list) (json-encode-plist list))
((listp list) (json-encode-array list))
(t
(signal 'json-error (list list)))))
;;; Arrays
;; Array parsing
(defun json-read-array ()
"Read the JSON array at point."
;; Skip over the "["
(json-advance)
(json-skip-whitespace)
;; read values until "]"
(let (elements)
(while (not (char-equal (json-peek) ?\]))
(push (json-read) elements)
(json-skip-whitespace)
(unless (char-equal (json-peek) ?\])
(if (char-equal (json-peek) ?,)
(json-advance)
(signal 'json-error (list 'bleah)))))
;; Skip over the "]"
(json-advance)
(apply json-array-type (nreverse elements))))
;; Array encoding
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(concat "[" (mapconcat 'json-encode array ", ") "]"))
;;; JSON reader.
(defvar json-readtable
(let ((table
'((?t json-read-keyword "true")
(?f json-read-keyword "false")
(?n json-read-keyword "null")
(?{ json-read-object)
(?\[ json-read-array)
(?\" json-read-string))))
(mapc (lambda (char)
(push (list char 'json-read-number) table))
'(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
table)
"Readtable for JSON reader.")
(defun json-read ()
"Parse and return the JSON object following point.
Advances point just past JSON object."
(json-skip-whitespace)
(let ((char (json-peek)))
(if (not (eq char :json-eof))
(let ((record (cdr (assq char json-readtable))))
(if (functionp (car record))
(apply (car record) (cdr record))
(signal 'json-readtable-error record)))
(signal 'end-of-file nil))))
;; Syntactic sugar for the reader
(defun json-read-from-string (string)
"Read the JSON object contained in STRING and return it."
(with-temp-buffer
(insert string)
(goto-char (point-min))
(json-read)))
(defun json-read-file (file)
"Read the first JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(json-read)))
;;; JSON encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string."
(cond ((memq object (list t json-null json-false))
(json-encode-keyword object))
((stringp object) (json-encode-string object))
((keywordp object) (json-encode-string
(substring (symbol-name object) 1)))
((symbolp object) (json-encode-string
(symbol-name object)))
((numberp object) (json-encode-number object))
((arrayp object) (json-encode-array object))
((hash-table-p object) (json-encode-hash-table object))
((listp object) (json-encode-list object))
(t (signal 'json-error (list object)))))
(provide 'json)
;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1
;;; json.el ends here

458
emacs.d/mojo.el
View file

@ -1,7 +1,18 @@
;;; mojo.el --- Interactive functions to aid the development of Palm Pre apps
(defconst mojo-version "0.2")
(require 'json)
;;; mojo.el --- Interactive functions to aid the development of webOS apps
(defconst mojo-version "0.9")
;; Copyright (c)2008 Jonathan Arkell. (by)(nc)(sa) Some rights reserved.
;; Author: Jonathan Arkell <jonnay@jonnay.net>
;; 2009 Sami Samhuri
;;
;; Authors: Jonathan Arkell <jonnay@jonnay.net>
;; Sami Samhuri <sami.samhuri@gmail.com>
;;
;; Latest version is available on github:
;; http://github.com/samsonjs/config/blob/master/emacs.d/mojo.el
;;
;; With sufficient interest mojo.el will get its own repo.
;; This file is not part of GNU Emacs.
@ -20,19 +31,29 @@
;;; Commentary:
(defgroup mojo '()
"Interactive functions to aid the development of Palm Pre apps.
"Interactive functions to aid the development of webOS apps.
This package is in Early Beta, (they did just release the SDK).
I am open to any contributions or ideas. For now just post on
the Emacs Wiki, but soon there will be a spot on github for it.")
This package is in early beta. I am open to any contributions or
ideas. Send me a pull request on github if you hack on mojo.el.")
;;; Installation:
;; Put mojo.el somewhere in your load-path.
;; Put json.el and mojo.el somewhere in your load-path.
;; (Use M-x show-variable RET load-path to see what your load path is.)
;; Add this to your Emacs init file.
;(require 'mojo)
;;
;; Make sure you customize the variables:
;; `mojo-project-directory' and `mojo-sdk-directory'
;; `mojo-project-directory', `mojo-sdk-directory' and `mojo-build-directory'
;;
;; I recommend that you define a few keyboard shortcuts in your .emacs file.
;; Maybe something like this:
;;
;; (global-set-key [f2] 'mojo-generate-scene)
;; (global-set-key [f3] 'mojo-emulate)
;; (global-set-key [f4] 'mojo-package)
;; (global-set-key [f5] 'mojo-package-install-and-inspect)
;;
;;
;;; Commands:
;;
@ -40,24 +61,29 @@ the Emacs Wiki, but soon there will be a spot on github for it.")
;;
;; `mojo-generate'
;; Generate a new Mojo application in the `mojo-project-directory'.
;; `mojo-generate-scene'
;; Generate a new Mojo scene for the application in `mojo-root'.
;; `mojo-emulate'
;; Launch the palm emulator.
;; `mojo-package'
;; Package up an application inside of DIR.
;; Package the current application.
;; `mojo-install'
;; Install PACKAGE. The emulator needs to be running.
;; Install the specified package for the current application.
;; The emulator needs to be running.
;; `mojo-list'
;; List all installed packages.
;; `mojo-delete'
;; Remove application named APP-NAME.
;; `mojo-launch'
;; Launch application APP-NAME in an emulator.
;; Launch the current application in an emulator.
;; `mojo-close'
;; Close launched application APP-NAME.
;; Close launched application.
;; `mojo-inspect'
;; Run the dom inspector on APP-NAME.
;; Run the dom inspector on the current application.
;; `mojo-hard-reset'
;; Perform a hard reset, clearing all data.
;; `mojo-package-install-and-inspect'
;; Package, install, and launch the specified app for inspection.
;;
;;; Customizable Options:
;;
@ -69,6 +95,8 @@ the Emacs Wiki, but soon there will be a spot on github for it.")
;; `mojo-project-directory'
;; Directory where all your Mojo projects are located.
;; default = ""
;; `mojo-build-directory'
;; Directory to build Mojo applications in.
;; `mojo-debug'
;; Run Mojo in debug mode. Assumed true while in such an early version.
;; default = t
@ -77,6 +105,32 @@ the Emacs Wiki, but soon there will be a spot on github for it.")
;;
;;; CHANGELOG:
;;
;; v 0.9 - Automatically find Mojo project root by searching upwards
;; for appinfo.json.
;;
;; - Added command for generating new scenes,
;; mojo-generate-scene.
;;
;; - mojo-package now operates only on the current project.
;;
;; - Parse appinfo.json to get version, used for installing &
;; launching with less interaction.
;;
;; - mojo-install, mojo-launch, mojo-inspect, and mojo-delete
;; still read in arguments but have the current project/app as
;; the default values.
;;
;; - New convenience method: mojo-package-install-and-inspect
;; This function only operates on the active app and does not
;; read in any input.
;;
;; - Remembered filenames and app ids are cleared when the Mojo
;; project root changes. (DWIM)
;;
;; - Parse output of `palm-install --list` for app id
;; completion. App id completion was ported from cheat.el.
;;
;; v 0.2 - Fixed some minor bugs
;; v 0.1 - Initial release
@ -86,7 +140,7 @@ the Emacs Wiki, but soon there will be a spot on github for it.")
(case system-type
((windows-nt) "c:/progra~1/palm/sdk")
((darwin) "/opt/PalmSDK/Current")
(t "/opt/PalmSDK/Current"))
(t ""))
"Path to where the mojo SDK is.
Note, using the old-school dos name of progra~1 was the only way i could make
@ -94,23 +148,16 @@ this work."
:type 'directory
:group 'mojo)
(defcustom mojo-project-directory "~/Projects/brighthouse/webOS"
(defcustom mojo-project-directory ""
"Directory where all your Mojo projects are located."
:type 'directory
:group 'mojo)
(defcustom mojo-build-directory (expand-file-name "build" mojo-project-directory)
"Directory where builds are saved."
(defcustom mojo-build-directory ""
"Directory where built projects are saved."
:type 'directory
:group 'mojo)
;;* buffer const
(defconst mojo-buffer-name "*mojo*")
;;* buffer var
(defvar mojo-buffer nil
"Buffer that spits out any mojo commandline messages.")
;;* debug
(defcustom mojo-debug t
"Run Mojo in debug mode. Assumed true while in such an early version."
@ -118,41 +165,11 @@ this work."
:group 'mojo)
(defun drop-last-path-component (path)
"Get the head of a path by dropping the last component."
(if (string= "/" path)
path
(substring path 0 (- (length path)
(length (last-path-component path))
1)))) ;; subtract one more for the trailing slash
(defun last-path-component (path)
"Get the tail of a path, i.e. the last component."
(if (string= "/" path)
path
(let ((start -2))
(while (not (string= "/" (substring path start (+ start 1))))
(setq start (- start 1)))
(substring path (+ start 1)))))
(defun find-project-subdirectory (path)
"Find a project's subdirectory under mojo-project-directory."
(let ((project-subdirectory (expand-file-name mojo-project-directory))
(last-component (last-path-component path))
(dir-prefix path))
;; remove last path element until we find the project subdir under mojo-project-directory
(while (and (not (string= project-subdirectory dir-prefix))
(not (string= "/" dir-prefix)))
(setq last-component (last-path-component dir-prefix))
(setq dir-prefix (drop-last-path-component dir-prefix)))
(concat dir-prefix "/" last-component)))
;;* interactive generate
(defun mojo-generate (title directory)
"Generate a new Mojo application in the `mojo-project-directory'.
TITLE is the name of the application.
ID is the id of the application.
DIRECTORY is the directory where the files are stored."
;;TODO handle existing directories (use --overwrite)
(interactive "sTitle: \nsDirectory Name (inside of mojo-project-directory): \n")
@ -160,9 +177,22 @@ DIRECTORY is the directory where the files are stored."
(when (file-exists-p mojo-dir)
(error "Cannot mojo-generate onto an existing directory! (%s)" mojo-dir))
(make-directory mojo-dir)
(mojo-cmd "palm-generate" (list "-p" (format "\"{'title':'%s'}\"" title) mojo-dir))
(mojo-cmd "palm-generate" (list "-p" (format "\"{'title':'%s'}\"" title)
mojo-dir))
(find-file (concat mojo-dir "/appinfo.json"))))
;;* interactive
(defun mojo-generate-scene (name)
"Generate a new Mojo scene for the current application.
NAME is the name of the scene."
(interactive "sScene Name: \n")
(let ((mojo-dir (mojo-root)))
(mojo-cmd "palm-generate" (list "-t" "new_scene"
"-p" (format "name=%s" name) mojo-dir))
(find-file (format "%s/app/assistants/%s-assistant.js" mojo-dir name))
(find-file (format "%s/app/views/%s/%s-scene.html" mojo-dir name name))))
;;* interactive
(defun mojo-emulate ()
"Launch the palm emulator."
@ -171,15 +201,16 @@ DIRECTORY is the directory where the files are stored."
;;* interactive
(defun mojo-package ()
"Package up an application inside of DEFAULT-DIRECTORY for the current buffer."
"Package the current application into `MOJO-BUILD-DIRECTORY'."
(interactive)
(mojo-cmd "palm-package" (list "-o" mojo-build-directory (find-project-subdirectory))))
(mojo-cmd "palm-package" (list "-o" (expand-file-name mojo-build-directory)
(mojo-root))))
;;* interactive
(defun mojo-install (package)
"Install PACKAGE. The emulator needs to be running."
(interactive "fInstall Package File: ")
(mojo-cmd "palm-install" (list (expand-file-name package))))
(defun mojo-install ()
"Install the package named by `MOJO-PACKAGE-FILENAME'. The emulator needs to be running."
(interactive)
(mojo-cmd "palm-install" (list (expand-file-name (mojo-read-package-filename)))))
;;* interactive
(defun mojo-list ()
@ -188,28 +219,28 @@ DIRECTORY is the directory where the files are stored."
(mojo-cmd "palm-install" (list "--list")))
;;* interactive
(defun mojo-delete (app-name)
"Remove application named APP-NAME."
(interactive "sDelete App: ")
(mojo-cmd "palm-install" (list "-r" app-name)))
(defun mojo-delete ()
"Remove the current application using `MOJO-APP-ID'."
(interactive)
(mojo-cmd "palm-install" (list "-r" (mojo-read-app-id))))
;;* interactive
(defun mojo-launch (app-name)
"Launch application APP-NAME in an emulator."
(interactive "sApp Name to Launch: ")
(mojo-cmd "palm-launch" (list app-name)))
(defun mojo-launch ()
"Launch the current application in an emulator."
(interactive)
(mojo-cmd "palm-launch" (list (mojo-read-app-id))))
;;* interactive
(defun mojo-close (app-name)
"Close launched application APP-NAME."
(interactive "sPackage Name:")
(mojo-cmd "palm-launch" (list "-c" app-name)))
(defun mojo-close ()
"Close launched application."
(interactive)
(mojo-cmd "palm-launch" (list "-c" (mojo-read-app-id))))
;;* launch interactive
(defun mojo-inspect (app-name)
"Run the dom inspector on APP-NAME."
(interactive "sPackage Name:")
(mojo-cmd "palm-launch" (list "-i" app-name)))
(defun mojo-inspect ()
"Run the DOM inspector on the current application."
(interactive)
(mojo-cmd "palm-launch" (list "-i" (mojo-read-app-id))))
;;* emulator interactive
(defun mojo-hard-reset ()
@ -221,6 +252,216 @@ DIRECTORY is the directory where the files are stored."
"Use `browse-url' to visit your application with Palm Host."
(browse-url "http://localhost:8888"))
;;* interactive
(defun mojo-package-install-and-inspect ()
"Package, install, and launch the current application for inspection."
(interactive)
(mojo-package)
(mojo-cmd "palm-install" (list (expand-file-name (mojo-package-filename))))
(mojo-cmd "palm-launch" (list "-i" (mojo-app-id))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some support functions that grok the basics of a Mojo project. ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun drop-last-path-component (path)
"Get the head of a path by dropping the last component."
(if (< (length path) 2)
path
(substring path 0 (- (length path)
(length (last-path-component path))
1)))) ;; subtract one more for the trailing slash
(defun last-path-component (path)
"Get the tail of a path, i.e. the last component."
(if (< (length path) 2)
path
(let ((start -2))
(while (not (string= "/" (substring path start (+ start 1))))
(setq start (- start 1)))
(substring path (+ start 1)))))
(defvar *mojo-last-root* ""
"Last Mojo root found by `MOJO-ROOT'.")
(defun mojo-root ()
"Find a Mojo project's root directory starting with `DEFAULT-DIRECTORY'."
(let ((last-component (last-path-component default-directory))
(dir-prefix default-directory))
;; remove last path element until we find appinfo.json
(while (and (not (file-exists-p (concat dir-prefix "/appinfo.json")))
(not (< (length dir-prefix) 2)))
(setq last-component (last-path-component dir-prefix))
(setq dir-prefix (drop-last-path-component dir-prefix)))
;; If no Mojo root found, ask for a directory.
(if (< (length dir-prefix) 2)
(setq dir-prefix (mojo-read-root)))
;; Invalidate cached values when changing projects.
(if (or (blank *mojo-last-root*)
(not (string= dir-prefix *mojo-last-root*)))
(progn
(setq *mojo-last-root* dir-prefix)
(setq *mojo-package-filename* nil)
(setq *mojo-app-id* nil)))
dir-prefix))
(defun read-json-file (filename)
"Parse the JSON in FILENAME and return the result."
(let ((origbuffer (current-buffer))
(filebuffer (find-file filename))
(text))
(goto-char (point-min)) ;; in case buffer already open
(let ((text (buffer-string)))
(switch-to-buffer origbuffer)
(json-read-from-string text))))
(defun mojo-app-version ()
"Parse the project version from the appinfo.json file in `MOJO-ROOT'."
(let ((appinfo (read-json-file (concat (mojo-root) "/appinfo.json"))))
(cdr (assoc 'version appinfo))))
(defun mojo-app-id ()
"Parse the project id from the appinfo.json file in `MOJO-ROOT'."
(let ((appinfo (read-json-file (concat (mojo-root) "/appinfo.json"))))
(cdr (assoc 'id appinfo))))
(defun mojo-package-filename ()
"Get the package filename for the specified application."
(format "%s/%s_%s_all.ipk" (expand-file-name mojo-build-directory)
(mojo-app-id) (mojo-app-version)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; app listing and completion ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mojo-app-cache-file ()
(concat (mojo-root) "/.applist"))
(defvar *mojo-app-id* nil
"Most recently used application id.")
(defvar *mojo-package-filename* nil
"Most recently used package file.")
(defvar *mojo-app-history* nil
"List of the most recently used application ids.")
;; cache expires hourly by default
(defvar *mojo-app-cache-ttl* 3600
"The minimum age of a stale cache file, in seconds.")
(defvar *mojo-package-history* nil
"List of the most recently used package filenames.")
;; this is from rails-lib.el in the emacs-rails package
(defun string-join (separator strings)
"Join all STRINGS using SEPARATOR."
(mapconcat 'identity strings separator))
(defun blank (thing)
"Return T if THING is nil or an empty string, otherwise nil."
(or (null thing)
(and (stringp thing)
(= 0 (length thing)))))
(defun mojo-read-root ()
"Get the path to a Mojo application, prompting with completion and
history."
(read-file-name "Mojo project: " (expand-file-name (concat mojo-project-directory
"/"))))
(defun mojo-read-package-filename ()
"Get the filename of a packaged application, prompting with completion and
history.
The app id is stored in *mojo-package-filename* unless it was blank."
(let* ((default (or *mojo-package-filename*
(mojo-package-filename)))
(package (read-file-name (format "Package file (default: %s): " default)
(concat mojo-build-directory "/") default t)))
(setq *mojo-package-filename* (last-path-component package))
(expand-file-name package)))
(defun mojo-read-app-id (&optional prompt)
"Get the id of an existing application, prompting with completion and
history.
The app id is stored in *mojo-app-id* unless it was blank."
(let* ((default (or *mojo-app-id* (mojo-app-id)))
(prompt (or prompt
(format "App id (default: %s): " default)))
(app-id (completing-read prompt
(mojo-app-list t)
nil
t
nil
'*mojo-app-history*
default)))
(when (blank app-id)
(setq app-id (mojo-app-id)))
(setq *mojo-app-id* app-id)
app-id))
(defun mojo-app-list (&optional fetch-if-missing-or-stale)
"Get a list of installed Mojo applications."
(cond ((and (file-readable-p (mojo-app-cache-file))
(not (mojo-app-cache-stale-p)))
(save-excursion
(let* ((buffer (find-file (mojo-app-cache-file)))
(apps (split-string (buffer-string))))
(kill-buffer buffer)
apps)))
(fetch-if-missing-or-stale
(mojo-cache-app-list)
(mojo-app-list)) ;; guaranteed cache hit this time
(t nil)))
(defun mojo-fetch-app-list ()
"Fetch a fresh list of all applications."
(let* ((raw-list (nthcdr 7 (split-string (mojo-cmd-to-string "palm-install" (list "--list")))))
(apps '())
(n (length raw-list))
(i 0))
(while (< i n)
(if (= 0 (mod i 3))
(push (pop raw-list) apps)
(pop raw-list))
(incf i))
(reverse apps)))
(defun mojo-cache-app-list ()
"Cache the list of applications in `MOJO-APP-CACHE-FILE'. Return the
list."
(save-excursion
(let ((buffer (find-file (mojo-app-cache-file)))
(apps (mojo-fetch-app-list)))
(insert (string-join "\n" apps))
(basic-save-buffer)
(kill-buffer buffer)
apps)))
(defun mojo-app-cache-stale-p ()
"Non-nil if the cache in `MOJO-APP-CACHE-FILE' is more than
*mojo-app-cache-ttl* seconds old.
If the cache file does not exist then it is considered stale."
(or (null (file-exists-p (mojo-app-cache-file)))
(let* ((now (float-time (current-time)))
(last-mod (float-time (sixth (file-attributes
(mojo-app-cache-file)))))
(age (- now last-mod)))
(> age *mojo-app-cache-ttl*))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;* lowlevel luna
(defun mojo-luna-send (url data)
"Send something through luna.
@ -232,57 +473,38 @@ This is a low level Emacs interface to luna-send.
URL is the luna url, and DATA is the data."
(mojo-cmd "luna-send" (list "-n" "1" url data)))
(when nil
(mojo-get-app-list))
;;* lowlevel app list
(defun mojo-get-app-list ()
"Retrieve list of all installed applications.
List is in the format of:
(id version name)
and stored inside of `mojo--app-list'"
(save-excursion
(set-buffer mojo-buffer)
(setq mojo--app-list (point))
(set-process-sentinel (mojo-list) 'mojo--comint-list-sentinal)))
;;* var list
(defvar mojo--app-list nil
"Variable for storing the current app list.")
;;* hook list
(defun mojo--comint-process-filter-applist (output)
"Bunk function. Kept for reference. To Be Removed."
(if (string-match "\\([A-Za-z.]+\\) \\([0-9]+\\.[0-9.]+\\) \"\\(.+\\)\"")
(aput mojo--app-list (match-string 1) (list (match-string 2) (match-string 3)))))
;;* hook list
(defun mojo--list-sentinal (proc state)
"Still in progress."
(if mojo-debug (message "Process got state %s" state))
(if (integerp mojo--app-list)
(save-excursion
(set-buffer mojo-buffer)
(goto-char mojo-app-list)
(line-down 2))))
(defun mojo-path-to-cmd (cmd)
"Return the absolute path to a Mojo SDK command line program."
)
;;* lowlevel cmd
(defun mojo-cmd (cmd args)
"General interface for running mojo-skd commands.
"General interface for running mojo-sdk commands.
CMD is the name of the command (without path or extension) to execute.
Automagically shell quoted.
ARGS is a list of all arguments to the command.
These arguments are NOT shell quoted."
(when (or (null mojo-buffer)
(not (buffer-live-p mojo-buffer)))
(setq mojo-buffer (get-buffer-create mojo-buffer-name)))
(let ((cmd (case system-type
((windows-nt) (concat mojo-sdk-directory "/bin/" cmd ".bat"))
(t (concat mojo-sdk-directory "/bin/" cmd)))))
(if mojo-debug (message "running %s with args %s " cmd args))
(apply 'start-process "mojo" mojo-buffer cmd args)))
(if mojo-debug (message "running %s with args %s " cmd (string-join " " args)))
(shell-command (concat cmd " " (string-join " " args)))))
;;* lowlevel cmd
(defun mojo-cmd-to-string (cmd args)
"General interface for running mojo-skd commands and capturing the output
to a string.
CMD is the name of the command (without path or extension) to execute.
Automatically shell quoted.
ARGS is a list of all arguments to the command.
These arguments are NOT shell quoted."
(let ((cmd (case system-type
((windows-nt) (concat mojo-sdk-directory "/bin/" cmd ".bat"))
(t (concat mojo-sdk-directory "/bin/" cmd)))))
(if mojo-debug (message "running %s with args %s " cmd (string-join " " args)))
(shell-command-to-string (concat cmd " " (string-join " " args)))))
(provide 'mojo)