diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/w3m-haddock.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/w3m-haddock.el | 190 |
1 files changed, 190 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/w3m-haddock.el b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/w3m-haddock.el new file mode 100644 index 000000000000..ee6ce43722d2 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/w3m-haddock.el @@ -0,0 +1,190 @@ +;;; -*- 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 "ext:w3m") +(declare-function w3m-browse-url "ext: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) + +(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 run 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) |