ol-man.el (3621B)
1 ;;; ol-man.el --- Links to man pages -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020-2023 Free Software Foundation, Inc. 4 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 5 ;; Maintainer: Bastien Guerry <bzg@gnu.org> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; URL: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 ;; 25 ;;; Commentary: 26 27 (require 'org-macs) 28 (org-assert-version) 29 30 (require 'ol) 31 32 (org-link-set-parameters "man" 33 :follow #'org-man-open 34 :export #'org-man-export 35 :store #'org-man-store-link) 36 37 (defcustom org-man-command 'man 38 "The Emacs command to be used to display a man page." 39 :group 'org-link 40 :type '(choice (const man) (const woman))) 41 42 (defun org-man-open (path _) 43 "Visit the manpage on PATH. 44 PATH should be a topic that can be thrown at the man command. 45 If PATH contains extra ::STRING which will use `occur' to search 46 matched strings in man buffer." 47 (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) 48 (let* ((command (match-string 1 path)) 49 (search (match-string 2 path)) 50 (buffer (funcall org-man-command command))) 51 (when search 52 (with-current-buffer buffer 53 (goto-char (point-min)) 54 (unless (search-forward search nil t) 55 (let ((process (get-buffer-process buffer))) 56 (while (process-live-p process) 57 (accept-process-output process))) 58 (goto-char (point-min)) 59 (search-forward search)) 60 (forward-line -1) 61 (let ((point (point))) 62 (let ((window (get-buffer-window buffer))) 63 (set-window-point window point) 64 (set-window-start window point))))))) 65 66 (defun org-man-store-link () 67 "Store a link to a README file." 68 (when (memq major-mode '(Man-mode woman-mode)) 69 ;; This is a man page, we do make this link 70 (let* ((page (org-man-get-page-name)) 71 (link (concat "man:" page)) 72 (description (format "Manpage for %s" page))) 73 (org-link-store-props 74 :type "man" 75 :link link 76 :description description)))) 77 78 (defun org-man-get-page-name () 79 "Extract the page name from the buffer name." 80 ;; This works for both `Man-mode' and `woman-mode'. 81 (if (string-match " \\(\\S-+\\)\\*" (buffer-name)) 82 (match-string 1 (buffer-name)) 83 (error "Cannot create link to this man page"))) 84 85 (defun org-man-export (link description format) 86 "Export a man page link from Org files." 87 (let ((path (format "http://man.he.net/?topic=%s§ion=all" link)) 88 (desc (or description link))) 89 (cond 90 ((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc)) 91 ((eq format 'latex) (format "\\href{%s}{%s}" path desc)) 92 ((eq format 'texinfo) (format "@uref{%s,%s}" path desc)) 93 ((eq format 'ascii) (format "%s (%s)" desc path)) 94 ((eq format 'md) (format "[%s](%s)" desc path)) 95 (t path)))) 96 97 (provide 'ol-man) 98 99 ;;; ol-man.el ends here