Klimi's new dotfiles with stow.
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.

474 lines
20 KiB

преди 4 години
  1. ;;; org-ref-helm.el --- Generic helm functions for org-ref -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2016 John Kitchin
  3. ;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
  4. ;; Keywords:
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;; These are not specific to helm-bibtex.
  17. ;;; Code:
  18. (declare-function 'org-ref-get-bibtex-key-and-file "org-ref-core.el")
  19. (declare-function 'org-ref-bad-file-link-candidates "org-ref-core.el")
  20. (declare-function 'org-ref-get-labels "org-ref-core.el")
  21. (declare-function 'org-ref-bad-cite-candidates "org-ref-core.el")
  22. (declare-function 'org-ref-bad-ref-candidates "org-ref-core.el")
  23. (declare-function 'org-ref-bad-label-candidates "org-ref-core.el")
  24. (require 'helm)
  25. (require 'org-element)
  26. (require 'org-ref-core)
  27. ;;;###autoload
  28. (defun org-ref-helm-insert-label-link ()
  29. "Insert label link at point.
  30. Helm will display existing labels in the current buffer to avoid
  31. duplication. If you use a prefix arg insert a radio target
  32. instead of a label."
  33. (interactive)
  34. (let ((labels (org-ref-get-labels)))
  35. (helm :sources `(,(helm-build-sync-source "Existing labels"
  36. :candidates labels
  37. :action (lambda (label)
  38. (with-helm-current-buffer
  39. (org-open-link-from-string
  40. (format "ref:%s" label)))))
  41. ,(helm-build-dummy-source "Create new label"
  42. :action (lambda (label)
  43. (with-helm-current-buffer
  44. (if helm-current-prefix-arg
  45. (insert (concat "<<" label ">>"))
  46. (insert (concat "label:" label)))))))
  47. :buffer "*helm labels*")))
  48. ;;;###autoload
  49. (defun org-ref-helm-insert-ref-link ()
  50. "Helm menu to insert ref links to labels in the document.
  51. If you are on link, replace with newly selected label. Use
  52. \\[universal-argument] to insert a different kind of ref link.
  53. Use a double \\[universal-argument] \\[universal-argument] to insert a
  54. [[#custom-id]] link"
  55. (interactive)
  56. (let* ((labels (org-ref-get-labels))
  57. (contexts (mapcar 'org-ref-get-label-context labels))
  58. (cb (current-buffer)))
  59. (helm :input (thing-at-point 'word)
  60. :sources `(((name . "Available labels to ref")
  61. (multiline)
  62. (candidates . ,(cl-loop for label in labels
  63. for context in contexts
  64. ;; we do some kludgy adding spaces
  65. ;; and bars to make it "easier" to
  66. ;; see in helm.
  67. collect (cons (concat
  68. label "\n"
  69. (mapconcat
  70. (lambda (x)
  71. (concat " |" x))
  72. (split-string context "\n")
  73. "\n"
  74. ) "\n\n") label)))
  75. ;; default action to replace or insert ref link.
  76. (action . (lambda (label)
  77. (switch-to-buffer ,cb)
  78. (cond
  79. ;; no prefix or on a link
  80. ((equal helm-current-prefix-arg nil)
  81. (let* ((object (org-element-context))
  82. (last-char
  83. (save-excursion
  84. (goto-char (org-element-property :end object))
  85. (backward-char)
  86. (if (looking-at " ")
  87. " "
  88. ""))))
  89. (if (-contains? org-ref-ref-types
  90. (org-element-property :type object))
  91. ;; we are on a link, so replace it.
  92. (setf
  93. (buffer-substring
  94. (org-element-property :begin object)
  95. (org-element-property :end object))
  96. (concat
  97. (replace-regexp-in-string
  98. (org-element-property :path object)
  99. label
  100. (org-element-property :raw-link object))
  101. last-char))
  102. ;; insert a new link
  103. (insert
  104. (concat
  105. org-ref-default-ref-type ":" label))
  106. )))
  107. ;; one prefix, alternate ref link
  108. ((equal helm-current-prefix-arg '(4))
  109. (insert
  110. (concat
  111. (helm :sources `((name . "Ref link types")
  112. (candidates . ,org-ref-ref-types)
  113. (action . (lambda (x) x))))
  114. ":" label)))
  115. ;; two prefixes, insert section custom-id link
  116. ((equal helm-current-prefix-arg '(16))
  117. (insert
  118. (format "[[#%s]]" label)))))))))))
  119. ;;;###autoload
  120. (defun org-ref ()
  121. "Opens a helm interface to actions for `org-ref'.
  122. Shows bad citations, ref links and labels.
  123. This widens the file so that all links go to the right place."
  124. (interactive)
  125. ;; (widen)
  126. ;; (org-cycle '(64))
  127. (let ((cb (current-buffer))
  128. (bad-citations (org-ref-bad-cite-candidates))
  129. (bad-refs (org-ref-bad-ref-candidates))
  130. (bad-labels (org-ref-bad-label-candidates))
  131. (bad-files (org-ref-bad-file-link-candidates))
  132. (bib-candidates '())
  133. (unreferenced-labels '())
  134. natbib-required
  135. natbib-used
  136. cleveref-required
  137. cleveref-used
  138. biblatex-required
  139. biblatex-used
  140. (org-latex-prefer-user-labels (and (boundp 'org-latex-prefer-user-labels)
  141. org-latex-prefer-user-labels)))
  142. ;; See if natbib, biblatex or cleveref are required
  143. (org-element-map (org-element-parse-buffer) 'link
  144. (lambda (link)
  145. (when (member (org-element-property :type link) org-ref-natbib-types)
  146. (setq natbib-required t))
  147. (when (member (org-element-property :type link) org-ref-biblatex-types)
  148. (setq biblatex-required t))
  149. (when (member (org-element-property :type link) '("cref" "Cref"))
  150. (setq cleveref-required t)))
  151. nil t)
  152. ;; See if natbib is probably used. This will miss a case where natbib is included somehow.
  153. (setq natbib-used
  154. (or
  155. (member "natbib" (mapcar (lambda (x) (when (listp x) (nth 1 x))) org-latex-default-packages-alist))
  156. (member "natbib" (mapcar (lambda (x) (when (listp x) (nth 1 x))) org-latex-packages-alist))
  157. ;; see of something like \usepackage{natbib} exists.
  158. (save-excursion
  159. (goto-char (point-min))
  160. (re-search-forward "{natbib}" nil t))))
  161. (setq biblatex-used
  162. (or
  163. (member "biblatex" (mapcar (lambda (x) (when (listp x) (nth 1 x))) org-latex-default-packages-alist))
  164. (member "biblatex" (mapcar (lambda (x) (when (listp x) (nth 1 x))) org-latex-packages-alist))
  165. ;; see of something like \usepackage{biblatex} exists.
  166. (save-excursion
  167. (goto-char (point-min))
  168. (re-search-forward "{biblatex}" nil t))))
  169. (setq cleveref-used
  170. (or
  171. (member "cleveref" (mapcar (lambda (x) (when (listp x) (nth 1 x))) org-latex-default-packages-alist))
  172. (member "cleveref" (mapcar (lambda (x) (when (listp x) (nth 1 x))) org-latex-packages-alist))
  173. ;; see of something like \usepackage{cleveref} exists.
  174. (save-excursion
  175. (goto-char (point-min))
  176. (re-search-forward "{cleveref}" nil t))))
  177. ;; setup bib-candidates. This checks a variety of things in the
  178. ;; bibliography, bibtex files. check for which bibliographies are used
  179. (cl-pushnew
  180. (cons (format "Using these bibtex files: %s"
  181. (org-ref-find-bibliography))
  182. (lambda () nil))
  183. bib-candidates)
  184. ;; Check bibliography style exists
  185. (save-excursion
  186. (goto-char 0)
  187. (unless (re-search-forward "bibliographystyle:\\|\\\\bibliographystyle{" nil t)
  188. (cl-pushnew
  189. (cons "No bibliographystyle found."
  190. (lambda ()
  191. (switch-to-buffer "*org-ref*")
  192. (erase-buffer)
  193. (insert "No bibliography style found. This may be ok, if your latex class style sets that up, but if not this is an error. Try adding something like:
  194. bibliographystyle:unsrt
  195. at the end of you file.
  196. ")
  197. (org-mode)))
  198. bib-candidates)))
  199. ;; Check if latex knows of the bibliographystyle. We only check links here.
  200. ;; I also assume this style exists as a bst file that kpsewhich can find.
  201. (save-excursion
  202. (goto-char 0)
  203. (when (re-search-forward "bibliographystyle:" nil t)
  204. ;; on a link. get style
  205. (let ((path (org-element-property :path (org-element-context))))
  206. (unless (= 0 (shell-command (format "kpsewhich %s.bst" path)))
  207. (cl-pushnew
  208. (cons (format "bibliographystyle \"%s\" may be unknown" path)
  209. (lambda ()
  210. (goto-char 0)
  211. (re-search-forward "bibliographystyle:")))
  212. bib-candidates)))))
  213. ;; check for multiple bibliography links
  214. (let* ((bib-links (-filter
  215. (lambda (el)
  216. (string= (org-element-property :type el) "bibliography"))
  217. (org-element-map (org-element-parse-buffer) 'link 'identity)))
  218. (n-bib-links (length bib-links)))
  219. (when (> n-bib-links 1)
  220. (mapc (lambda (link)
  221. (setq
  222. bib-candidates
  223. (append
  224. bib-candidates
  225. (list (cons (format "Multiple bibliography link: %s"
  226. (org-element-property :raw-link link))
  227. `(lambda ()
  228. (goto-char ,(org-element-property :begin link))))))))
  229. bib-links)))
  230. ;; Check for bibliography files existence.
  231. (mapc (lambda (bibfile)
  232. (unless (file-exists-p bibfile)
  233. (cl-pushnew
  234. (cons
  235. (format "%s does not exist." bibfile)
  236. (lambda ()
  237. (message "Non-existent bibfile.")))
  238. bib-candidates)))
  239. (org-ref-find-bibliography))
  240. ;; check for spaces in bibliography
  241. (let ((bibfiles (mapcar 'expand-file-name
  242. (org-ref-find-bibliography))))
  243. (mapc (lambda (bibfile)
  244. (when (string-match " " bibfile)
  245. (cl-pushnew
  246. (cons (format "One or more spaces found in path to %s" bibfile)
  247. (lambda ()
  248. (message "No spaces are allowed in bibtex file paths. We recommend replacing them with -. Underscores usually cause other problems if you don't know what you are doing.")))
  249. bib-candidates)))
  250. bibfiles))
  251. ;; validate bibtex files
  252. (let ((bibfiles (mapcar 'expand-file-name
  253. (org-ref-find-bibliography))))
  254. (mapc
  255. (lambda (bibfile)
  256. (unless (with-current-buffer
  257. (find-file-noselect bibfile)
  258. (bibtex-validate))
  259. (cl-pushnew
  260. (cons
  261. (format "Invalid bibtex file found. %S" bibfile)
  262. `(lambda ()
  263. (find-file ,bibfile)))
  264. bib-candidates)))
  265. bibfiles))
  266. ;; unreferenced labels
  267. (save-excursion
  268. (save-restriction
  269. (widen)
  270. (goto-char (point-min))
  271. (let ((matches '()))
  272. ;; these are the org-ref label:stuff kinds
  273. (while (re-search-forward
  274. "[^#+]label:\\([a-zA-Z0-9:-]*\\)" nil t)
  275. (cl-pushnew (cons
  276. (match-string-no-properties 1)
  277. (point))
  278. matches))
  279. ;; now add all the other kinds of labels.
  280. ;; #+label:
  281. (save-excursion
  282. (goto-char (point-min))
  283. (while (re-search-forward "^#\\+label:\\s-+\\(.*\\)\\b" nil t)
  284. ;; do not do this for tables. We get those in `org-ref-get-tblnames'.
  285. ;; who would have thought you have save match data here? Trust me. When
  286. ;; I wrote this, you did.
  287. (unless (save-match-data (equal (car (org-element-at-point)) 'table))
  288. (cl-pushnew (cons (match-string-no-properties 1) (point)) matches))))
  289. ;; \label{}
  290. (save-excursion
  291. (goto-char (point-min))
  292. (while (re-search-forward "\\\\label{\\([a-zA-Z0-9:-]*\\)}"
  293. nil t)
  294. (cl-pushnew (cons (match-string-no-properties 1) (point)) matches)))
  295. ;; #+tblname: and actually #+label
  296. (cl-loop for cell in (org-element-map (org-element-parse-buffer 'element) 'table
  297. (lambda (table)
  298. (cons (org-element-property :name table)
  299. (org-element-property :begin table))))
  300. do
  301. (cl-pushnew cell matches))
  302. ;; CUSTOM_IDs
  303. (org-map-entries
  304. (lambda ()
  305. (let ((custom_id (org-entry-get (point) "CUSTOM_ID")))
  306. (when (not (null custom_id))
  307. (cl-pushnew (cons custom_id (point)) matches)))))
  308. (goto-char (point-min))
  309. (while (re-search-forward "^#\\+name:\\s-+\\(.*\\)" nil t)
  310. (cl-pushnew (cons (match-string 1) (point)) matches))
  311. ;; unreference labels
  312. (let ((refs (org-element-map (org-element-parse-buffer) 'link
  313. (lambda (el)
  314. (when (or (string= "ref" (org-element-property :type el))
  315. (string= "eqref" (org-element-property :type el))
  316. (string= "pageref" (org-element-property :type el))
  317. (string= "nameref" (org-element-property :type el))
  318. (string= "autoref" (org-element-property :type el))
  319. (string= "cref" (org-element-property :type el))
  320. (string= "Cref" (org-element-property :type el)))
  321. (org-element-property :path el))))))
  322. (cl-loop for (label . p) in matches
  323. do
  324. (when (and label (not (-contains? refs label)))
  325. (cl-pushnew
  326. (cons label (set-marker (make-marker) p))
  327. unreferenced-labels)))))))
  328. (helm :sources `(((name . "Bad citations")
  329. (candidates . ,bad-citations)
  330. (action . (lambda (marker)
  331. (switch-to-buffer (marker-buffer marker))
  332. (goto-char marker)
  333. (org-show-entry))))
  334. ((name . "Multiply defined labels")
  335. (candidates . ,bad-labels)
  336. (action . (lambda (marker)
  337. (switch-to-buffer (marker-buffer marker))
  338. (goto-char marker)
  339. (org-show-entry))))
  340. ((name . "Bad ref links")
  341. (candidates . ,bad-refs)
  342. (action . (lambda (marker)
  343. (switch-to-buffer (marker-buffer marker))
  344. (goto-char marker)
  345. (org-show-entry))))
  346. ((name . "Bad file links")
  347. (candidates . ,bad-files)
  348. (lambda (marker)
  349. (switch-to-buffer (marker-buffer marker))
  350. (goto-char marker)
  351. (org-show-entry)))
  352. ((name . "Labels with no ref links")
  353. (candidates . ,unreferenced-labels)
  354. (action . (lambda (marker)
  355. (switch-to-buffer (marker-buffer marker))
  356. (goto-char marker)
  357. (org-show-entry))))
  358. ((name . "Bibliography")
  359. (candidates . ,bib-candidates)
  360. (action . (lambda (x)
  361. (switch-to-buffer ,cb)
  362. (funcall x))))
  363. ((name . "Miscellaneous")
  364. (candidates . (,(format "org-latex-prefer-user-labels = %s"
  365. org-latex-prefer-user-labels)
  366. ,(format "bibtex-dialect = %s" bibtex-dialect)
  367. ,(format "biblatex is%srequired." (if biblatex-required " " " not "))
  368. ,(format "biblatex is%sused." (if biblatex-used " " " not "))
  369. ,(format "org-version = %s" (org-version))
  370. ,(format "completion backend = %s" org-ref-completion-library)
  371. ,(format "org-latex-pdf-process is defined as %s" org-latex-pdf-process)
  372. ,(format "natbib is%srequired." (if natbib-required " " " not "))
  373. ,(format "natbib is%sused." (if natbib-used " " " not "))
  374. ,(format "cleveref is%srequired." (if cleveref-required " " " not "))
  375. ,(format "cleveref is%sused." (if cleveref-used " " " not "))))
  376. (action . nil))
  377. ((name . "Utilities")
  378. (candidates . (("Check buffer again" . org-ref)
  379. ("Insert citation" . helm-bibtex)
  380. ("Insert label link" . org-ref-helm-insert-label-link)
  381. ("Insert ref link" . org-ref-helm-insert-ref-link)
  382. ("List of figures" . org-ref-list-of-figures)
  383. ("List of tables" . org-ref-list-of-tables)
  384. ("Table of contents" . helm-org-in-buffer-headings)))
  385. (action . (lambda (x)
  386. (switch-to-buffer ,cb)
  387. (funcall x))))
  388. ((name . "Document utilities")
  389. (candidates . (("Spell check document" . ispell)))
  390. (action . (lambda (x)
  391. (switch-to-buffer ,cb)
  392. (funcall x))))
  393. ;; Exports
  394. ((name . "Export functions")
  395. (candidates . (("Extract cited entries" . org-ref-extract-bibtex-entries)
  396. ("Export to html and open" . (lambda ()
  397. (org-open-file
  398. (org-html-export-to-html))))
  399. ("Export to pdf and open" . (lambda ()
  400. (org-open-file
  401. (org-latex-export-to-pdf))))
  402. ("Export to manuscript pdf and open" . ox-manuscript-export-and-build-and-open)
  403. ("Export submission manuscript pdf and open" . ox-manuscript-build-submission-manuscript-and-open)))
  404. (action . (lambda (x)
  405. (switch-to-buffer ,cb)
  406. (funcall x))))))))
  407. ;;;###autoload
  408. (defun helm-tag-bibtex-entry ()
  409. "Helm interface to add keywords to a bibtex entry.
  410. Run this with the point in a bibtex entry."
  411. (interactive)
  412. (let ((keyword-source `((name . "Existing keywords")
  413. (candidates . ,(org-ref-bibtex-keywords))
  414. (action . (lambda (candidate)
  415. (org-ref-set-bibtex-keywords
  416. (mapconcat
  417. 'identity
  418. (helm-marked-candidates)
  419. ", "))))))
  420. (fallback-source `((name . "Add new keywords")
  421. (dummy)
  422. (action . (lambda (candidate)
  423. (org-ref-set-bibtex-keywords helm-pattern))))))
  424. (helm :sources `(,keyword-source ,fallback-source))))
  425. (provide 'org-ref-helm)
  426. ;;; org-ref-helm.el ends here