Merge pull request #173 from vermiculus/visit-question-from-link

Visit question from link

5 files changed, 97 insertions, 7 deletions

diff --git a/sx-interaction.el b/sx-interaction.el
index baf8c13..372a5b1 100644
--- a/sx-interaction.el
+++ b/sx-interaction.el
@@ -107,7 +107,7 @@ Only fields contained in TO are copied."
 
 
 ;;; Visiting
-(defun sx-visit (data &optional copy-as-kill)
+(defun sx-visit-externally (data &optional copy-as-kill)
   "Visit DATA in a web browser.
 DATA can be a question, answer, or comment. Interactively, it is
 derived from point position.
@@ -129,13 +129,31 @@ If DATA is a question, also mark it as read."
       (sx-question--mark-read data)
       (sx--maybe-update-display))))
 
+(defun sx-open-link (link)
+  "Visit element given by LINK inside Emacs.
+Element can be a question, answer, or comment."
+  (interactive
+   (let ((def (with-temp-buffer
+                (save-excursion (yank))
+                (thing-at-point 'url))))
+     (list (read-string (concat "Link (" def "): ") nil nil def))))
+  (let ((data (sx--link-to-data link)))
+    (sx-assoc-let data
+      (cl-case .type
+        (answer
+         (sx-display-question
+          (sx-question-get-from-answer .site .id) 'focus))
+        (question
+         (sx-display-question
+          (sx-question-get-question .site .id) 'focus))))))
+
 
 ;;; Displaying
 (defun sx-display-question (&optional data focus window)
   "Display question given by DATA, on WINDOW.
 When DATA is nil, display question under point. When FOCUS is
 non-nil (the default when called interactively), also focus the
-relevant window. 
+relevant window.
 
 If WINDOW nil, the window is decided by
 `sx-question-mode-display-buffer-function'."
@@ -255,13 +273,13 @@ If SILENT is nil, message the user about this limit."
 
 (defun sx--get-post (type site id)
   "Find in the database a post identified by TYPE, SITE and ID.
-TYPE is `question' or `answer'. 
+TYPE is `question' or `answer'.
 SITE is a string.
 ID is an integer."
   (let ((db (cons sx-question-mode--data
                   sx-question-list--dataset)))
     (setq db
-          (cond 
+          (cond
            ((string= type "question") db)
            ((string= type "answer")
             (apply #'cl-map 'list #'identity
diff --git a/sx-question-list.el b/sx-question-list.el
index 6537d2b..62ce032 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -317,7 +317,7 @@ into consideration.
    (":" sx-question-list-switch-site)
    ("t" sx-tab-switch)
    ("a" sx-ask)
-   ("v" sx-visit)
+   ("v" sx-visit-externally)
    ("u" sx-toggle-upvote)
    ("d" sx-toggle-downvote)
    ("h" sx-question-list-hide)
diff --git a/sx-question-mode.el b/sx-question-mode.el
index 8d06078..a60cf3a 100644
--- a/sx-question-mode.el
+++ b/sx-question-mode.el
@@ -224,7 +224,7 @@ Letters do not insert themselves; instead, they are commands.
    ("p" sx-question-mode-previous-section)
    ("g" sx-question-mode-refresh)
    ("c" sx-comment)
-   ("v" sx-visit)
+   ("v" sx-visit-externally)
    ("u" sx-toggle-upvote)
    ("d" sx-toggle-downvote)
    ("q" quit-window)
diff --git a/sx-question.el b/sx-question.el
index 9fb31fc..801384a 100644
--- a/sx-question.el
+++ b/sx-question.el
@@ -54,6 +54,20 @@ If QUESTION-ID doesn't exist on SITE, raise an error."
       (error "Couldn't find question %S in %S"
              question-id site))))
 
+(defun sx-question-get-from-answer (site answer-id)
+  "Get question from SITE to which ANSWER-ID belongs.
+If ANSWER-ID doesn't exist on SITE, raise an error."
+  (let ((res (sx-method-call 'answers
+               :id answer-id
+               :site site
+               :submethod 'questions
+               :auth t
+               :filter sx-browse-filter)))
+    (if (vectorp res)
+        (elt res 0)
+      (error "Couldn't find answer %S in %S"
+             answer-id site))))
+
 
 ;;; Question Properties
 
diff --git a/sx.el b/sx.el
index a31c0a0..508de46 100644
--- a/sx.el
+++ b/sx.el
@@ -61,7 +61,16 @@ DATA can also be the link itself."
                 (cdr (assoc 'link data)))))
     (when (stringp link)
       (replace-regexp-in-string
-       "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$"
+       (rx string-start
+           "http" (optional "s") "://"
+           (or
+            (sequence
+             (group-n 1 (+ (not (any "/"))))
+             ".stackexchange")
+            (group-n 2 (+ (not (any "/")))))
+           "." (+ (not (any ".")))
+           "/" (* any)
+           string-end)
        "\\1\\2" link))))
 
 (defun sx--ensure-site (data)
@@ -74,6 +83,54 @@ with a `link' property)."
                          (cdr data))))
     data))
 
+(defun sx--link-to-data (link)
+  "Convert string LINK into data that can be displayed."
+  (let ((result (list (cons 'site (sx--site link)))))
+    ;; Try to strip a question or answer ID
+    (when (or
+           ;; Answer
+           (and (or (string-match
+                     ;; From 'Share' button
+                     (rx "/a/"
+                         ;; Question ID
+                         (group (+ digit))
+                         ;; User ID
+                         "/" (+ digit)
+                         ;; Answer ID
+                         (group (or (sequence "#" (* any)) ""))
+                         string-end) link)
+                    (string-match
+                     ;; From URL
+                     (rx "/questions/" (+ digit) "/"
+                         (+ (not (any "/"))) "/"
+                         ;; User ID
+                         (optional (group (+ digit)))
+                         (optional "/")
+                         (group (or (sequence "#" (* any)) ""))
+                         string-end) link))
+                (push '(type . answer) result))
+           ;; Question
+           (and (or (string-match
+                     ;; From 'Share' button
+                     (rx "/q/"
+                         ;; Question ID
+                         (group (+ digit))
+                         ;; User ID
+                         (optional "/" (+ digit))
+                         ;; Answer or Comment ID
+                         (group (or (sequence "#" (* any)) ""))
+                         string-end) link)
+                    (string-match
+                     ;; From URL
+                     (rx "/questions/"
+                         ;; Question ID
+                         (group (+ digit))
+                         "/") link))
+                (push '(type . question) result)))
+      (push (cons 'id (string-to-number (match-string-no-properties 1 link)))
+            result))
+    result))
+
 (defmacro sx-assoc-let (alist &rest body)
   "Identical to `let-alist', except `.site' has a special meaning.
 If ALIST doesn't have a `site' property, one is created using the
@@ -318,6 +375,7 @@ removed from the display name before it is returned."
           (format "[%s]" (car kar)) (cdr kar) string)))
     string))
 
+
 (defcustom sx-init-hook nil
   "Hook run when SX initializes.
 Run after `sx-init--internal-hook'."