ol-man.el (4988B)
1 ;;; ol-man.el --- Links to man pages -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020-2024 Free Software Foundation, Inc. 4 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 5 ;; Maintainer: Bastien Guerry <bzg@gnu.org> 6 ;; Keywords: outlines, hypermedia, calendar, text 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 ;; This file implements links to man pages from within Org mode. 28 29 ;;; Code: 30 31 (require 'org-macs) 32 (org-assert-version) 33 34 (require 'ol) 35 36 (org-link-set-parameters "man" 37 :complete #'org-man-complete 38 :follow #'org-man-open 39 :export #'org-man-export 40 :store #'org-man-store-link) 41 42 (defcustom org-man-command 'man 43 "The Emacs command to be used to display a man page." 44 :group 'org-link 45 :type '(choice (const man) (const :tag "WoMan (obsolete)" woman))) 46 47 (declare-function Man-translate-references "man" (ref)) 48 (defun org-man-open (path _) 49 "Visit the manpage on PATH. 50 PATH should be a topic that can be thrown at the man command. 51 If PATH contains extra ::STRING which will use `occur' to search 52 matched strings in man buffer." 53 (require 'man) ; For `Man-translate-references' 54 (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path) 55 (let* ((command (match-string 1 path)) 56 ;; FIXME: Remove after we drop Emacs 29 support. 57 ;; Working around security bug #66390. 58 (command (if (not (equal (Man-translate-references ";id") ";id")) 59 ;; We are on Emacs that escapes man command args 60 ;; (see Emacs commit 820f0793f0b). 61 command 62 ;; Older Emacs without the fix - escape the 63 ;; arguments ourselves. 64 (mapconcat 'identity 65 (mapcar #'shell-quote-argument 66 (split-string command "\\s-+")) 67 " "))) 68 (search (match-string 2 path)) 69 (buffer (funcall org-man-command command))) 70 (when search 71 (with-current-buffer buffer 72 (goto-char (point-min)) 73 (unless (search-forward search nil t) 74 (let ((process (get-buffer-process buffer))) 75 (while (process-live-p process) 76 (accept-process-output process))) 77 (goto-char (point-min)) 78 (search-forward search)) 79 (forward-line -1) 80 (let ((point (point))) 81 (let ((window (get-buffer-window buffer))) 82 (set-window-point window point) 83 (set-window-start window point))))))) 84 85 (defun org-man-store-link (&optional _interactive?) 86 "Store a link to a README file." 87 (when (memq major-mode '(Man-mode woman-mode)) 88 ;; This is a man page, we do make this link 89 (let* ((page (org-man-get-page-name)) 90 (link (concat "man:" page)) 91 (description (format "Manpage for %s" page))) 92 (org-link-store-props 93 :type "man" 94 :link link 95 :description description)))) 96 97 (defun org-man-get-page-name () 98 "Extract the page name from the buffer name." 99 ;; This works for both `Man-mode' and `woman-mode'. 100 (if (string-match " \\(\\S-+\\)\\*" (buffer-name)) 101 (match-string 1 (buffer-name)) 102 (error "Cannot create link to this man page"))) 103 104 (defun org-man-export (link description backend) 105 "Export a man page LINK with DESCRIPTION. 106 BACKEND is the current export backend." 107 (let ((path (format "http://man.he.net/?topic=%s§ion=all" link)) 108 (desc (or description link))) 109 (cond 110 ((eq backend 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc)) 111 ((eq backend 'latex) (format "\\href{%s}{%s}" path desc)) 112 ((eq backend 'texinfo) (format "@uref{%s,%s}" path desc)) 113 ((eq backend 'ascii) (format "[%s] (<%s>)" desc path)) 114 ((eq backend 'md) (format "[%s](%s)" desc path)) 115 (t path)))) 116 117 (defvar Man-completion-cache) ; Defined in `man'. 118 (defun org-man-complete (&optional _arg) 119 "Complete man pages for `org-insert-link'." 120 (require 'man) 121 (concat 122 "man:" 123 (let ((completion-ignore-case t) ; See `man' comments. 124 (Man-completion-cache)) ; See `man' implementation. 125 (completing-read 126 "Manual entry: " 127 'Man-completion-table)))) 128 129 (provide 'ol-man) 130 131 ;;; ol-man.el ends here