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