You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
191 lines
6.5 KiB
191 lines
6.5 KiB
;;; -*- lexical-binding: t -*- |
|
;;; w3m-haddock.el --- Make browsing haddocks with w3m-mode better. |
|
|
|
;; Copyright (C) 2014 Chris Done |
|
|
|
;; Author: Chris Done <chrisdone@gmail.com> |
|
|
|
;; This file is not part of GNU Emacs. |
|
|
|
;; This file is free software; you can redistribute it and/or modify |
|
;; it under the terms of the GNU General Public License as published by |
|
;; the Free Software Foundation; either version 3, or (at your option) |
|
;; any later version. |
|
|
|
;; This file is distributed in the hope that it will be useful, |
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
;; GNU General Public License for more details. |
|
|
|
;; You should have received a copy of the GNU General Public License |
|
;; along with GNU Emacs; see the file COPYING. If not, write to |
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
;; Boston, MA 02110-1301, USA. |
|
|
|
(require 'cl-lib) |
|
(require 'haskell-mode) |
|
(require 'haskell-font-lock) |
|
|
|
(declare-function w3m-buffer-title "w3m") |
|
(declare-function w3m-browse-url "w3m") |
|
(defvar w3m-current-url) |
|
|
|
(add-hook 'w3m-display-hook 'w3m-haddock-display) |
|
|
|
;;;###autoload |
|
(defface w3m-haddock-heading-face |
|
'((((class color)) :inherit highlight)) |
|
"Face for quarantines." |
|
:group 'haskell) |
|
|
|
;;;###autoload |
|
(defcustom haskell-w3m-haddock-dirs |
|
'("~/.cabal/share/doc/") |
|
"The path to your cabal documentation dir. It should contain |
|
directories of package-name-x.x. |
|
|
|
You can rebind this if you're using hsenv by adding it to your |
|
.dir-locals.el in your project root. E.g. |
|
|
|
((haskell-mode . ((haskell-w3m-haddock-dirs . (\"/home/chris/Projects/foobar/.hsenv/cabal/share/doc\"))))) |
|
|
|
" |
|
:group 'haskell |
|
:type 'list) |
|
|
|
(defvar w3m-haddock-entry-regex "^\\(\\(data\\|type\\) \\|[a-z].* :: \\)" |
|
"Regex to match entry headings.") |
|
|
|
(defun haskell-w3m-open-haddock () |
|
"Open a haddock page in w3m." |
|
(interactive) |
|
(let* ((entries (cl-remove-if (lambda (s) (string= s "")) |
|
(apply 'append (mapcar (lambda (dir) |
|
(split-string (shell-command-to-string (concat "ls -1 " dir)) |
|
|
|
"\n")) |
|
haskell-w3m-haddock-dirs)))) |
|
(package-dir (ido-completing-read |
|
"Package: " |
|
entries))) |
|
(cond |
|
((member package-dir entries) |
|
(unless (cl-loop for dir in haskell-w3m-haddock-dirs |
|
when (w3m-haddock-find-index dir package-dir) |
|
do (progn (w3m-browse-url (w3m-haddock-find-index dir package-dir) |
|
t) |
|
(cl-return t))) |
|
(w3m-browse-url (concat "http://hackage.haskell.org/package/" |
|
package-dir) |
|
t))) |
|
(t |
|
(w3m-browse-url (concat "http://hackage.haskell.org/package/" |
|
package-dir) |
|
t))))) |
|
|
|
(defun w3m-haddock-find-index (dir package) |
|
(let ((html-index (concat dir "/" package "/html/index.html")) |
|
(index (concat dir "/" package "/index.html"))) |
|
(cond |
|
((file-exists-p html-index) |
|
html-index) |
|
((file-exists-p index) |
|
index)))) |
|
|
|
(defun w3m-haddock-page-p () |
|
"Haddock general page?" |
|
(save-excursion |
|
(goto-char (point-max)) |
|
(forward-line -2) |
|
(looking-at "[ ]*Produced by Haddock"))) |
|
|
|
(defun w3m-haddock-source-p () |
|
"Haddock source page?" |
|
(save-excursion |
|
(goto-char (point-min)) |
|
(or (looking-at "Location: https?://hackage.haskell.org/package/.*/docs/src/") |
|
(looking-at "Location: file://.*cabal/share/doc/.*/html/src/") |
|
(looking-at "Location: .*src/.*.html$")))) |
|
|
|
(defun w3m-haddock-p () |
|
"Any haddock page?" |
|
(or (w3m-haddock-page-p) |
|
(w3m-haddock-source-p))) |
|
|
|
(defun w3m-haddock-find-tag () |
|
"Find a tag by jumping to the \"All\" index and doing a |
|
search-forward." |
|
(interactive) |
|
(when (w3m-haddock-p) |
|
(let ((ident (haskell-ident-at-point))) |
|
(when ident |
|
(w3m-browse-url |
|
(replace-regexp-in-string "docs/.*" "docs/doc-index-All.html" w3m-current-url)) |
|
(search-forward ident))))) |
|
|
|
(defun w3m-haddock-display (_url) |
|
"To be ran by w3m's display hook. This takes a normal w3m |
|
buffer containing hadddock documentation and reformats it to be |
|
more usable and look like a dedicated documentation page." |
|
(when (w3m-haddock-page-p) |
|
(save-excursion |
|
(goto-char (point-min)) |
|
(let ((inhibit-read-only t)) |
|
(delete-region (point) |
|
(line-end-position)) |
|
(w3m-haddock-next-heading) |
|
;; Start formatting entries |
|
(while (looking-at w3m-haddock-entry-regex) |
|
(when (w3m-haddock-valid-heading) |
|
(w3m-haddock-format-heading)) |
|
(w3m-haddock-next-heading)))) |
|
(rename-buffer (concat "*haddock: " (w3m-buffer-title (current-buffer)) "*"))) |
|
(when (w3m-haddock-source-p) |
|
(font-lock-mode -1) |
|
(let ((n (line-number-at-pos))) |
|
(save-excursion |
|
(goto-char (point-min)) |
|
(forward-line 1) |
|
(let ((text (buffer-substring (point) |
|
(point-max))) |
|
(inhibit-read-only t)) |
|
(delete-region (point) |
|
(point-max)) |
|
(insert |
|
(haskell-fontify-as-mode text |
|
'haskell-mode)))) |
|
(goto-char (point-min)) |
|
(forward-line (1- n))))) |
|
|
|
(defun w3m-haddock-format-heading () |
|
"Format a haddock entry." |
|
(let ((o (make-overlay (line-beginning-position) |
|
(1- (save-excursion (w3m-haddock-header-end)))))) |
|
(overlay-put o 'face 'w3m-haddock-heading-face)) |
|
(let ((end (save-excursion |
|
(w3m-haddock-next-heading) |
|
(when (w3m-haddock-valid-heading) |
|
(point))))) |
|
(when end |
|
(save-excursion |
|
(w3m-haddock-header-end) |
|
(indent-rigidly (point) |
|
end |
|
4))))) |
|
|
|
(defun w3m-haddock-next-heading () |
|
"Go to the next heading, or end of the buffer." |
|
(forward-line 1) |
|
(or (search-forward-regexp w3m-haddock-entry-regex nil t 1) |
|
(goto-char (point-max))) |
|
(goto-char (line-beginning-position))) |
|
|
|
(defun w3m-haddock-valid-heading () |
|
"Is this a valid heading?" |
|
(not (get-text-property (point) 'face))) |
|
|
|
(defun w3m-haddock-header-end () |
|
"Go to the end of the header." |
|
(search-forward-regexp "\n[ \n]")) |
|
|
|
(provide 'w3m-haddock)
|
|
|