clojure-emacs-hacks/clojuredocs.el at master · kriyative/clojure-emacs-hacks · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
;;; Search and view Clojure documentation from clojuredocs.org
;;;

(require 'clojure-mode-ext)
(require 'clojure-slime-ext)
(require 'json)

(defconst clojuredocs-uri-prefix "http://clojuredocs.org")
(defconst google-uri-prefix "http://google.com")

(defun clojuredocs-find-uri (sym &optional prefix-map uri-formatter)
  (let ((match (find-if (lambda (pair)
			  (string-match (first pair) sym))
			(or prefix-map clojuredocs-prefix-map))))
    (when match
      (funcall (or uri-formatter 'clojuredocs-uri-formatter) sym (cdr match)))))

(defvar clojuredocs-prefix-map
  '(("^ring" . "/ring/%s")
    ("^clojure\.core" . "/clojure_core/%s")))

(defun clojuredocs-uri-formatter (sym format-string)
  (concat clojuredocs-uri-prefix (format format-string sym) "#top"))

(defvar javadocs-prefix-map
  '(("^\\(java[x]?.\\|org.ietf.\\|org.omg.\\|org.w3c.\\|org.xml.\\)"
     . "http://docs.oracle.com/javase/6/docs/api/%s.html")
    ("^org\.eclipse.jetty"
     . "http://download.eclipse.org/jetty/stable-7/apidocs/%s.html")
    ("^org\.apache\.log4j"
     . "http://logging.apache.org/log4j/1.2/apidocs/%s.html")
    ("^org\.apache\.commons\.codec"
     . "http://commons.apache.org/codec/apidocs/%s.html")))

(defun javadocs-uri-formatter (sym format-string)
  (format format-string (replace-regexp-in-string "\\." "/" sym)))

(defun clojuredocs-process-response-json (status
                                          on-success
                                          success-args
                                          on-error
                                          error-args)
  (goto-char (point-min))
  (search-forward-regexp "^HTTP/1.[01] \\([0-9][0-9][0-9]\\)" nil t)
  (unwind-protect
      (if (equal "200" (match-string 1))
          (condition-case c
              (progn
                (message "url-retrieve: OK")
                (search-forward-regexp "^$" nil t)
                (let ((json (json-read)))
                  (apply on-success json success-args)))
            (error
             (message "json-read error: %S" c)
             (apply on-error :json-error error-args)))
        (funcall on-error :url-error))
    (url-mark-buffer-as-dead (current-buffer))))

(defun assoc-val (key alist)
  (let ((a (assoc key alist)))
    (when a
      (cdr a))))

(defun clojuredocs-response-success (json)
  (let ((tmpfilename (make-temp-file "clojuredocs" nil ".html"))
        (title (format "clojuredocs search: %d results" (length json))))
    (message "tmpfilename: %s" tmpfilename)
    (with-temp-file tmpfilename
      (insert
       (format "<html>\n<head><title>%s</title></head>\n" title))
      (insert "<body>\n"
              (format "<h1>%s</h1>\n" title)
              "<ul>\n")
      (loop for el across json
            do (let ((url (assoc-val 'url el))
                     (ns (assoc-val 'ns el))
                     (name (assoc-val 'name el)))
                 (insert
                  (format "<li><a href='%s#top'>%s/%s</a></li>\n"
                          url
                          ns
                          name))))
      (insert "</ul></body></html>\n"))
    (browse-url
     (browse-url-file-url tmpfilename))))

(defun clojuredocs-response-error (error)
  (message "Problem communicating with clojuredocs (%s)" error))

(defun clojuredocs-find-or-search (sap)
  (url-retrieve (format "http://api.clojuredocs.org/search/%s" sap)
                'clojuredocs-process-response-json
                (list (lambda (json sap)
                        (if json
                            (clojuredocs-response-success json)
                          (browse-url
                           (format "%s/search?q=%s+clojure"
                                   google-uri-prefix
                                   sap))))
                      (list sap)
                      'clojuredocs-response-error
                      nil)))

(defun clojuredocs-render (sap type)
  (destructuring-bind (sap type)
      values
    (cond
     ((eq :var type)
      (let ((sap-uri (clojuredocs-find-uri sap)))
        (if sap-uri
            (browse-url sap-uri)
          (clojuredocs-find-or-search sap))))
     ((eq :class type)
      (browse-url
       (or (clojuredocs-find-uri sap javadocs-prefix-map 'javadocs-uri-formatter)
           (format "%s/search?%s&q=%s+javadoc"
                   google-uri-prefix
                   "btnI=I%27m+Feeling+Lucky&ie=UTF-8&oe=UTF-8"
                   sap)))))))

(defun clojuredocs ()
  "Get the symbol at point; or prompt for a symbol name, look it
up in the clojuredocs.org, or find a javadoc (if a Java class)
and render the results using the default web browser."
  (interactive)
  (if (not (slime-connected-p))
      (message "No clojure to talk to.")
    (destructuring-bind (status &rest values)
	(cljx/slime-resolve-symbol (or (cljx/symbol-at-point)
				       (region)
				       (read-string "ClojureDocs: ")))
      (if (eq :error status)
	  (apply 'message values)
	(apply 'clojuredocs-render values)))))

(provide 'clojuredocs)