;; elisp-dep-block >>
(require 'url);(url-retrieve)
(require 'url-auth);(url-register-auth-scheme)
(require 'url-util);(url-basepath)
(require 'url-parse);(url-set-password url-password url-set-user url-user url-filename url-port url-host url-generic-parse-url)
(require 'time-date);(seconds-to-time)
(require 'cl);(values)
;; elisp-dep-block <<
(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)
(make-variable-buffer-local 'unity-edit-data)
(put 'unity-edit-data 'permanent-local t)
(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)
(defun unity-uglify-string (string)
(apply 'concat
(split-string (upcase-initials string) "[ _-]+")) )
(defun unity-fix-string (string)
(let ((case-fold-search nil))
(replace-regexp-in-string
"\\([a-z]\\)\\([A-Z]\\)" "\\1 \\2" string :fixed-case) ))
(defun unity-default-user ()
"Return the username, asking the user if we haven't cached it."
(unity-uglify-string
(or unity-username
(setq unity-username
(read-string "unity username: "
(user-full-name) nil (user-full-name))))))
(defun unity-default-pass (&optional prompt ignored)
"Return the password, asking the user if we haven't cached it."
(or unity-password
(setq unity-password (read-passwd prompt))))
(defun unity-grep-values (beg end)
"Trawl through the current buffer between BEG and END, extract any
<input> 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 "<input[^>]+>" end t))
(setq x (match-beginning 0))
(goto-char x)
(search-forward-regexp "name\\s-*=\\s-*\"\\([^\"]*\\)\"" y t)
(setq name (match-string 1))
(goto-char x)
(search-forward-regexp "value\\s-*=\\s-*\"\\([^\"]*\\)\"" y t)
(setq val (match-string 1))
(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, ectract any
<textarea> values and return an ((name . value) ...) style alist of them."
(let ((texts nil) (name nil) (val nil) (x nil) (y nil))
(save-excursion
(goto-char beg)
(while
(setq x
(search-forward-regexp
"<textarea[^>]+name\\s-*=\\s-*\"\\([^\"]*\\)\"[^>]+>" end t))
(setq name (match-string 1))
(message "found %s" name)
(search-forward-regexp "</textarea" end)
(message "x - y :: %d - %d" x (match-beginning 0))
(setq y (match-beginning 0)
val (buffer-substring-no-properties x y)
texts (cons (cons name val) texts)) ))
texts))
(defconst unity-sep-props
(list 'rear-nonsticky t
'read-only t
'face 'mode-line))
(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-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" name)
end (format "\n---- %s ----\n" name)
len (length end))
(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-edit-callback ()
"Once the edit page has been fetched, this does the work of parsing
the form and setting up the unity edit buffer."
(let ((case-fold-search t)
(form-beg nil)
(form-end nil)
(values nil)
(texts nil)
(inhibit-read-only t))
(beginning-of-buffer)
(let ((x (point)) (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))
)
)
(setq form-beg (progn (search-forward-regexp "<form") (match-beginning 0))
form-end (progn (search-forward-regexp "</form")(match-beginning 0))
values (unity-grep-values form-beg form-end)
texts (unity-grep-texts form-beg form-end)
ebuf (format "*Unity: %s [%s]*"
(unity-fix-string
(cdr (assoc "savepage" values)))
(unity-timestamp
(cdr (assoc "ts" values))) ) )
(if nil
(save-excursion
(let ((data-buf (current-buffer))
(min (point-min) )
(max (point-max) ))
(set-buffer (get-buffer-create "*unity debug data*"))
(insert-buffer-substring data-buf min max) )) )
(setq ebuf (get-buffer-create ebuf))
(pop-to-buffer ebuf)
(widen)
(delete-region (point-min) (point-max))
(setq unity-edit-data (list (cons :values values)
(cons :texts texts )) )
(mapcar (lambda (text) (unity-text-section text)) texts)
)
)
(defun unity-fetch (url callback &optional cbargs)
"Fetch a unity page for editing. URL may be a string or a preparsed
url vector. CALLBACK is the function to call in the response buffer
once the response has been received and inserted into it. CBARGS is
a list of arguments to be passed to the callback function."
(let ((url-registered-auth-schemes url-registered-auth-schemes)
(url-passwd-entry-func 'unity-default-pass)
(unity-fetching-url t)
(data-buffer nil))
(url-do-setup)
(url-register-auth-scheme "basic" 'url-basic-auth 5)
(message "url-registered-auth-schemes:\n%S"
url-registered-auth-schemes)
(setq data-buffer (url-retrieve url callback cbargs))
(save-excursion
(set-buffer data-buffer)
(set (make-local-variable 'url-registered-auth-schemes)
url-registered-auth-schemes)
(set (make-local-variable 'unity-fetching-url) t)
(set (make-local-variable 'url-passwd-entry-func) 'unity-default-pass)
)
)
)
(defun unity-edit (target)
"Edit a Unity page. The target need not be in any particular capitalisation:
words separated by spaces, dashes or underscores should work equally well.\n
Asynchronously fetches the Unity page in question, then displays a buffer
allowing you to edit the text and graveyard.\n
You may have more than one page open at once.\n
See also: `unity-save'"
(interactive "sunity target: ")
(let* ((url-path (unity-uglify-string target))
(url-string (concat unity-base-url "?edit=" url-path))
(url-vector nil))
(setq url-vector (url-generic-parse-url url-string))
;; get the username if it wasn't specified:
(and (url-user url-vector)
(setq unity-username (url-user url-vector))
(url-set-user url-vector nil))
;; get the password if it wasn't specified:
(and (url-password url-vector)
(setq unity-password (url-password url-vector))
(url-set-password url-vector nil))
;;(message "%s" url-string)
(unity-fetch url-vector 'unity-edit-callback nil)) )
;;
(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))))
S :fixed-case :literal )) string-list))
(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)
data (cons (cons name val) data)) ))
data))
(defun unity-save ()
"Save the current buffer's Unity page. Display the response from the
Unity server when done. (Ideally just the relevant text, but if unity.el
is uncertain of the response, it will barf up the whole response for you
to see.)"
(interactive)
(let ((save-text (unity-parse-buffer))
(save-vals (cdr (assoc :values unity-edit-data)))
(unity-buf (current-buffer))
(postdata nil)
(page nil))
(setq postdata
(apply 'concat
(mapcar
(lambda (X)
(apply (lambda (A B) (concat ";" A "=" B))
(unity-query-encode (list (car X) (cdr X)))))
(append save-text save-vals)) ) )
(setq postdata (substring postdata 1))
(setq page (cdr (assoc "savepage" save-vals)))
(let ((url-request-data postdata)
(url-request-method "POST" ))
(unity-fetch unity-base-url 'unity-display-response (list page unity-buf))
)
)
)
(defun unity-strip-tags (string)
"Strip <> tags from a copy of STRING and return it."
(replace-regexp-in-string "<[^>]+>" "" string))
(defun unity-display-response (&optional page buffer)
"If possible, fillet the Unity response and display it in the message area.
Otherwise show the whole response."
(interactive)
(save-excursion
(goto-char (point-min))
(let ((search
(format
"</table>\\(\\(?:.\\|\n\\)*?\\)<a [^>]*name\\s-*=\\s-*\"%s\""
page)))
(message "regex: %s" search)
(if (not (search-forward-regexp search nil :no-error))
(display-buffer (current-buffer))
(message "%s" (unity-strip-tags (match-string 1)))
(if (bufferp buffer) (message "would have killed buffer: %S" buffer)) )
)
)
) 