Klimi's new dotfiles with stow.
Não pode escolher mais do que 25 tópicos Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.

190 linhas
6.5 KiB

há 4 anos
  1. ;;; -*- lexical-binding: t -*-
  2. ;;; w3m-haddock.el --- Make browsing haddocks with w3m-mode better.
  3. ;; Copyright (C) 2014 Chris Done
  4. ;; Author: Chris Done <chrisdone@gmail.com>
  5. ;; This file is not part of GNU Emacs.
  6. ;; This file is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 3, or (at your option)
  9. ;; any later version.
  10. ;; This file is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs; see the file COPYING. If not, write to
  16. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  17. ;; Boston, MA 02110-1301, USA.
  18. (require 'cl-lib)
  19. (require 'haskell-mode)
  20. (require 'haskell-font-lock)
  21. (declare-function w3m-buffer-title "ext:w3m")
  22. (declare-function w3m-browse-url "ext:w3m")
  23. (defvar w3m-current-url)
  24. (add-hook 'w3m-display-hook 'w3m-haddock-display)
  25. ;;;###autoload
  26. (defface w3m-haddock-heading-face
  27. '((((class color)) :inherit highlight))
  28. "Face for quarantines."
  29. :group 'haskell)
  30. (defcustom haskell-w3m-haddock-dirs
  31. '("~/.cabal/share/doc/")
  32. "The path to your cabal documentation dir. It should contain
  33. directories of package-name-x.x.
  34. You can rebind this if you're using hsenv by adding it to your
  35. .dir-locals.el in your project root. E.g.
  36. ((haskell-mode . ((haskell-w3m-haddock-dirs . (\"/home/chris/Projects/foobar/.hsenv/cabal/share/doc\")))))
  37. "
  38. :group 'haskell
  39. :type 'list)
  40. (defvar w3m-haddock-entry-regex "^\\(\\(data\\|type\\) \\|[a-z].* :: \\)"
  41. "Regex to match entry headings.")
  42. (defun haskell-w3m-open-haddock ()
  43. "Open a haddock page in w3m."
  44. (interactive)
  45. (let* ((entries (cl-remove-if (lambda (s) (string= s ""))
  46. (apply 'append (mapcar (lambda (dir)
  47. (split-string (shell-command-to-string (concat "ls -1 " dir))
  48. "\n"))
  49. haskell-w3m-haddock-dirs))))
  50. (package-dir (ido-completing-read
  51. "Package: "
  52. entries)))
  53. (cond
  54. ((member package-dir entries)
  55. (unless (cl-loop for dir in haskell-w3m-haddock-dirs
  56. when (w3m-haddock-find-index dir package-dir)
  57. do (progn (w3m-browse-url (w3m-haddock-find-index dir package-dir)
  58. t)
  59. (cl-return t)))
  60. (w3m-browse-url (concat "http://hackage.haskell.org/package/"
  61. package-dir)
  62. t)))
  63. (t
  64. (w3m-browse-url (concat "http://hackage.haskell.org/package/"
  65. package-dir)
  66. t)))))
  67. (defun w3m-haddock-find-index (dir package)
  68. (let ((html-index (concat dir "/" package "/html/index.html"))
  69. (index (concat dir "/" package "/index.html")))
  70. (cond
  71. ((file-exists-p html-index)
  72. html-index)
  73. ((file-exists-p index)
  74. index))))
  75. (defun w3m-haddock-page-p ()
  76. "Haddock general page?"
  77. (save-excursion
  78. (goto-char (point-max))
  79. (forward-line -2)
  80. (looking-at "[ ]*Produced by Haddock")))
  81. (defun w3m-haddock-source-p ()
  82. "Haddock source page?"
  83. (save-excursion
  84. (goto-char (point-min))
  85. (or (looking-at "Location: https?://hackage.haskell.org/package/.*/docs/src/")
  86. (looking-at "Location: file://.*cabal/share/doc/.*/html/src/")
  87. (looking-at "Location: .*src/.*.html$"))))
  88. (defun w3m-haddock-p ()
  89. "Any haddock page?"
  90. (or (w3m-haddock-page-p)
  91. (w3m-haddock-source-p)))
  92. (defun w3m-haddock-find-tag ()
  93. "Find a tag by jumping to the \"All\" index and doing a
  94. search-forward."
  95. (interactive)
  96. (when (w3m-haddock-p)
  97. (let ((ident (haskell-ident-at-point)))
  98. (when ident
  99. (w3m-browse-url
  100. (replace-regexp-in-string "docs/.*" "docs/doc-index-All.html" w3m-current-url))
  101. (search-forward ident)))))
  102. (defun w3m-haddock-display (_url)
  103. "To be run by w3m's display hook. This takes a normal w3m
  104. buffer containing hadddock documentation and reformats it to be
  105. more usable and look like a dedicated documentation page."
  106. (when (w3m-haddock-page-p)
  107. (save-excursion
  108. (goto-char (point-min))
  109. (let ((inhibit-read-only t))
  110. (delete-region (point)
  111. (line-end-position))
  112. (w3m-haddock-next-heading)
  113. ;; Start formatting entries
  114. (while (looking-at w3m-haddock-entry-regex)
  115. (when (w3m-haddock-valid-heading)
  116. (w3m-haddock-format-heading))
  117. (w3m-haddock-next-heading))))
  118. (rename-buffer (concat "*haddock: " (w3m-buffer-title (current-buffer)) "*")))
  119. (when (w3m-haddock-source-p)
  120. (font-lock-mode -1)
  121. (let ((n (line-number-at-pos)))
  122. (save-excursion
  123. (goto-char (point-min))
  124. (forward-line 1)
  125. (let ((text (buffer-substring (point)
  126. (point-max)))
  127. (inhibit-read-only t))
  128. (delete-region (point)
  129. (point-max))
  130. (insert
  131. (haskell-fontify-as-mode text
  132. 'haskell-mode))))
  133. (goto-char (point-min))
  134. (forward-line (1- n)))))
  135. (defun w3m-haddock-format-heading ()
  136. "Format a haddock entry."
  137. (let ((o (make-overlay (line-beginning-position)
  138. (1- (save-excursion (w3m-haddock-header-end))))))
  139. (overlay-put o 'face 'w3m-haddock-heading-face))
  140. (let ((end (save-excursion
  141. (w3m-haddock-next-heading)
  142. (when (w3m-haddock-valid-heading)
  143. (point)))))
  144. (when end
  145. (save-excursion
  146. (w3m-haddock-header-end)
  147. (indent-rigidly (point)
  148. end
  149. 4)))))
  150. (defun w3m-haddock-next-heading ()
  151. "Go to the next heading, or end of the buffer."
  152. (forward-line 1)
  153. (or (search-forward-regexp w3m-haddock-entry-regex nil t 1)
  154. (goto-char (point-max)))
  155. (goto-char (line-beginning-position)))
  156. (defun w3m-haddock-valid-heading ()
  157. "Is this a valid heading?"
  158. (not (get-text-property (point) 'face)))
  159. (defun w3m-haddock-header-end ()
  160. "Go to the end of the header."
  161. (search-forward-regexp "\n[ \n]"))
  162. (provide 'w3m-haddock)