;; elisp-dep-block >>
(require 'time-date);(seconds-to-time)
(require 'url);(url-mark-buffer-as-dead url-retrieve)
(require 'url-auth);(url-register-auth-scheme)
(require 'url-cache);(url-cache-extract url-cache-create-filename url-store-in-cache)
(require 'url-http);(url-http-handle-authentication url-http-mark-connection-as-free url-http-debug)
;; elisp-dep-block <<
(defconst unity-version 0.18)
(defvar unity-username nil)
(defvar unity-password nil)
(defvar unity-base-url
"http://www.chiark.greenend.org.uk/~robh/unity/unity.cgi")
(defvar unity-fetching-url nil)
(defvar unity-edit-data nil
"An alist of alists: the top level keys are the classes of data
\(currently values and texts\) which are associated with an alist
of name/value pairs for that class of item.")
(make-variable-buffer-local 'unity-edit-data)
(put 'unity-edit-data 'permanent-local t)
(defvar unity-twin-buffers nil
"A list of buffers that should be killed when this buffer is killed.")
(make-variable-buffer-local 'unity-twin-buffers)
(put 'unity-twin-buffers 'permanent-local t)
(defcustom unity-electric-comments nil
"Whether to use the magic comment insertion function bound to \"<\""
:type '(boolean))
(defadvice read-string (around unity-ui activate)
"A little hackery to make the user name and password prompts from the
url libraries behave according to the unity.el convention that \"foo bar\"
is equivalent to its camel-cased form."
(when unity-fetching-url
(ad-set-arg 1 (or unity-username (user-full-name)))
(ad-set-arg 3 (or unity-username (user-full-name))))
(let ((p (ad-get-arg 0)) (flag unity-fetching-url) (unity-fetching-url nil))
(if (and flag (string-match "user" p))
(setq ad-return-value (unity-default-user))
ad-do-it))
(when unity-fetching-url
(setq ad-return-value (unity-uglify-string ad-return-value)))
ad-return-value)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; statistics
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun unity-mean (numbers)
"Return the mean of NUMBERS (a list). For convenience, an empty list
will elicit a response of 0."
(if numbers (/ (apply '+ (mapcar 'float numbers)) (length numbers)) 0))
(defun unity-sample-variance (values)
"Calculate the \(bias corrected\) sample variance for VALUES.
For reasons of convenience, we will return 0 for empty lists or lists
consisting of 1 item."
(let ( (mu (unity-mean values))
(j (float (- (length values) 1))) )
(if (memq j '(0 -1)) 0 ;; unsafe operation, return 0
(/ (apply '+
(mapcar (lambda (N) (expt (- (float N) mu) 2)) values)) j)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string munging
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun unity-uglify-string (string)
"Take a \"foo bar\" or \"foo_bar\" string and return its wiki word form."
(apply 'concat
(split-string (upcase-initials string) "[ _]+")) )
(defun unity-fix-string (string)
"Take a wiki word and expand into something readable."
(let ((case-fold-search nil))
(replace-regexp-in-string
"\\([a-z]\\)\\([A-Z]\\)" "\\1 \\2" string :fixed-case) ))
(defun unity-timestamp (time)
"Return TIME (a string or integer representing a time_t) as a timestamp."
(format-time-string
"%Y-%m-%d %H:%M:%S"
(cond ((stringp time) (seconds-to-time (string-to-number time)))
((integerp time) (seconds-to-time time))
(t (current-time))) ) )
(defun unity-query-encode (string-list)
(mapcar
(lambda (S)
(replace-regexp-in-string
"[^A-Za-z_0-9.\/-]"
(lambda (C) (if (equal C " ") "+" (format "%%%02x" (string-to-char C))))
(encode-coding-string S 'utf-8 t) :fixed-case :literal)) string-list))
(defun unity-strip-tags (string)
"Strip <> tags from a copy of STRING and return it."
(replace-regexp-in-string "<[^>]+>" "" string))
(defun unity-compact-string (string)
(replace-regexp-in-string "^\\s-+" "" string))
(defun unity-strip-markup (string)
(replace-regexp-in-string "'''?\\|[][]" "" string))
(defun unity-trim-whitespace (string)
(replace-regexp-in-string "^\\s-*\\|\\s-*$" "" string))
(defun unity-join (sep list)
(mapconcat 'identity list sep))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; unity widget creation/destruction
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst unity-sep-props
(list 'rear-nonsticky t
'read-only t
'fontified t
'intangible t
'face 'mode-line))
(defun unity-text-section (text-cons)
"Given a (name . value) cons TEXT-CONS, insert a unity text edit section
into the current buffer."
(let ((name (car text-cons))
(data (cdr text-cons))
(beg nil)
(end nil)
(len nil))
(setq beg (format "\n<%s> \n" (upcase name))
end (format "\n%s>\n" (upcase name))
len (length end))
(if (= (length data) 0) (setq data " "))
(put-text-property (- len 1) len 'unity-text-beg name beg)
(put-text-property 0 1 'unity-text-end name end)
(mapcar (lambda (str)
(add-text-properties 0 len unity-sep-props str)
(put-text-property 0 1 'face nil str)
(put-text-property (- len 1) len 'face nil str))
(list beg end))
(insert beg data end) ))
(defun unity-kill-related ()
"Kill any secondary buffers that shouldn't exist once this buffer is gone.
Targets are the buffers in `unity-twin-buffers'."
(let ((B unity-twin-buffers) (C (current-buffer)))
(setq unity-twin-buffers nil) ;; just in case of circular relationship.
(while B
(set-buffer (car B))
(bury-buffer)
(kill-buffer (car B))
(setq B (cdr B)))
(set-buffer C) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; unity and http buffer parsing (see also: table helper functions)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun unity-parse-buffer ()
"Grab the new savetext and graveyard values from the current buffer,
load them into a ((name .value) ...) alist and return it."
(let ((beg nil)
(end nil)
(val nil)
(name nil)
(data nil))
(save-excursion
(setq end (point-min))
(while (setq beg (next-single-property-change end 'unity-text-beg))
(setq name (get-text-property beg 'unity-text-beg)
end (next-single-property-change beg 'unity-text-end)
val (buffer-substring (+ 1 beg) end)
val (if (string-match "\\S-" val) val "")
data (cons (cons name val) data)) ))
data))
(defun unity-zap-invisible ()
"Remove text marked as \'invisible from the current buffer."
(save-excursion
(let ((x (point-min)) (y nil))
(while (setq x (next-single-property-change x 'invisible))
(when (get-text-property x 'invisible)
(setq y (or (next-single-property-change x 'invisible)
(point-max)))
(delete-region x y) )) )) )
(defun unity-grep-values (beg end)
"Trawl through the current buffer between BEG and END, extract any
values and return an ((name . value) ...) style alist of them."
(let ((values nil) (name nil) (val nil) (x nil) (y nil))
(save-excursion
(goto-char beg)
(while (setq y (search-forward-regexp "]+>" end t))
(setq x (match-beginning 0))
(goto-char x)
(search-forward-regexp "name\\s-*=\\s-*\"\\([^\"]*\\)\"" y t)
(if (setq name (match-string 1))
(setq name (decode-coding-string name 'utf-8)))
(goto-char x)
(search-forward-regexp "value\\s-*=\\s-*\"\\([^\"]*\\)\"" y t)
(if (setq val (match-string 1))
(setq val (decode-coding-string val 'utf-8)))
(if name (setq values (cons (cons name val) values))))
values)))
(defun unity-grep-texts (beg end)
"Trawl through the current buffer between BEG and END, extract any