Mercurial > hg > Members > kokubo > emacs
view .emacs.d/haskell-mode/w3m-haddock.el @ 0:2764b4f45f9f
1st commit
author | Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 21 Apr 2014 04:30:59 +0900 |
parents | |
children |
line wrap: on
line source
;;; 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 'w3m) (add-hook 'w3m-display-hook 'w3m-haddock-display) (defface w3m-haddock-heading-face '((((class color)) :background "#eeeeee")) "Face for quarantines." :group 'shm) (defcustom haskell-w3m-haddock-dir "~/.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-dir . \"/home/chris/Projects/foobar/.hsenv/cabal/share/doc\")))) " :group 'shm :type 'string) (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 (remove-if (lambda (s) (string= s "")) (split-string (shell-command-to-string (concat "ls -1 " haskell-w3m-haddock-dir)) "\n"))) (package-dir (ido-completing-read "Package: " entries))) (cond ((member package-dir entries) (w3m-browse-url (concat "file://" haskell-w3m-haddock-dir "/" package-dir "/html/index.html") t)) (t (w3m-browse-url (concat "http://hackage.haskell.org/package/" package-dir) t))))) (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-line 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)