+;;; Link button definitions
+;;
+
+(defvar elpher-link-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "S-<down-mouse-1>") 'ignore) ;Prevent buffer face popup
+ (define-key map (kbd "S-<mouse-1>") #'elpher--open-link-new-buffer-mouse)
+ (define-key map (kbd "S-<return>") #'elpher--open-link-new-buffer)
+ (set-keymap-parent map button-map)
+ map))
+
+(defun elpher--click-link (button)
+ "Function called when the gopher link BUTTON is activated."
+ (let ((page (button-get button 'elpher-page)))
+ (elpher-visit-page page)))
+
+(defun elpher--open-link-new-buffer ()
+ "Internal function used by Elpher to open links in a new buffer."
+ (interactive)
+ (let ((page (button-get (button-at (point)) 'elpher-page))
+ (new-buf (generate-new-buffer (default-value 'elpher-buffer-name))))
+ (pop-to-buffer new-buf)
+ (elpher-mode)
+ (elpher-visit-page page)))
+
+(defun elpher--open-link-new-buffer-mouse (event)
+ "Internal function used by Elpher to open links in a new buffer.
+The EVENT argument is the mouse event which caused this function to be
+called."
+ (interactive "e")
+ (mouse-set-point event)
+ (elpher--open-link-new-buffer))
+
+(defun elpher--page-button-help (_window buffer pos)
+ "Function called by Emacs to generate mouse-over text.
+The arguments specify the BUFFER and the POS within the buffer of the item
+for which help is required. The function returns the help to be
+displayed. The _WINDOW argument is currently unused."
+ (with-current-buffer buffer
+ (let ((button (button-at pos)))
+ (when button
+ (let* ((page (button-get button 'elpher-page))
+ (address (elpher-page-address page)))
+ (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))))))
+
+(define-button-type 'elpher-link
+ 'action #'elpher--click-link
+ 'keymap elpher-link-keymap
+ 'follow-link t
+ 'help-echo #'elpher--page-button-help
+ 'face 'button)