;; 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\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