1;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*- 2 3;; %CopyrightBegin% 4;; 5;; Copyright Ericsson AB 2016-2020. All Rights Reserved. 6;; 7;; Licensed under the Apache License, Version 2.0 (the "License"); 8;; you may not use this file except in compliance with the License. 9;; You may obtain a copy of the License at 10;; 11;; http://www.apache.org/licenses/LICENSE-2.0 12;; 13;; Unless required by applicable law or agreed to in writing, software 14;; distributed under the License is distributed on an "AS IS" BASIS, 15;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16;; See the License for the specific language governing permissions and 17;; limitations under the License. 18;; 19;; %CopyrightEnd% 20 21;;; Commentary: 22 23;; Crawl Erlang/OTP HTML documentation and generate lookup tables. 24;; 25;; This package depends on `cl-lib', `pcase' and 26;; `libxml-parse-html-region'. Emacs 24+ compiled with libxml2 should 27;; work. On Emacs 24.1 and 24.2 do `M-x package-install RET cl-lib 28;; RET' to install `cl-lib'. 29;; 30;; Please customise `erldoc-man-index' to point to your local OTP 31;; documentation. 32;; 33;; To use: 34;; 35;; (define-key help-map "u" 'erldoc-browse) 36;; (define-key help-map "t" 'erldoc-browse-topic) 37;; (define-key help-map "a" 'erldoc-apropos) 38;; 39;; Note: these commands trigger indexing OTP documentation on first 40;; run with cache to disk which may take 1-2 minutes. 41 42 43;;; Examples: 44 45;; 1. `M-x erldoc-browse RET erlang:integer_to_binary/2 RET' opens the 46;; `erlang' manual anchored on the entry for `integer_to_binary/2'. 47;; 48;; 2. `M-x erldoc-apropos RET first RET' list all MFAs matching 49;; substring `first'. 50;; 51;; 3. `M-x erldoc-browse-topic RET efficiency_guide#Introduction RET' 52;; opens chapter `Introduction' of the `Efficiency Guide' in the 53;; browser. 54 55;;; History: 56 57;; Written in December 2013 as a temporary solution to help me browse 58;; the rich Erlang/OTP documentation. Three years on I find myself 59;; still using it every day. - Leo (2016) 60 61;;; Code: 62 63(require 'cl-lib) 64(require 'json) 65(require 'erlang) 66(eval-when-compile (require 'url-parse)) 67 68(eval-and-compile ;for emacs < 24.3 69 (or (fboundp 'user-error) (defalias 'user-error 'error))) 70 71(defgroup erldoc nil 72 "Browse Erlang document." 73 :group 'help) 74 75(defcustom erldoc-man-index "http://www.erlang.org/doc/man_index.html" 76 "The URL to the man_index.html page. 77Note it is advisable to customise this to a local URL for example 78`file:///usr/local/19.1/lib/erlang/doc/man_index.html' to speed 79up the indexing." 80 :type 'string 81 :group 'erldoc) 82 83(defcustom erldoc-verify-man-path nil 84 "If non-nil verify man path existence for `file://'." 85 :type 'boolean 86 :group 'erldoc) 87 88(defcustom erldoc-output-file (locate-user-emacs-file "cache/erldoc") 89 "File to store the parsed results." 90 :type 'file 91 :group 'erldoc) 92 93(defcustom erldoc-no-signature-function #'ignore 94 "Notification function called if no function signature was found." 95 :type '(choice (function-item :tag "Ignore" ignore) 96 (function-item :tag "Warn" warn) 97 (function-item :tag "Error" error)) 98 :group 'erldoc) 99 100(defun erldoc-strip-string (s) 101 (let* ((re "[ \t\n\r\f\v\u00a0]+") 102 (from (if (string-match (concat "\\`" re) s) (match-end 0) 0)) 103 (to (and (string-match (concat re "\\'") s) (match-beginning 0)))) 104 (substring s from (and to (max to from))))) 105 106;; Note: don't know how to get the BASE-URL to 107;; `libxml-parse-html-region' to work. 108(defun erldoc-expand-url (url base-url) 109 (if (url-type (url-generic-parse-url url)) 110 url 111 (let* ((base (url-generic-parse-url base-url)) 112 (dir (directory-file-name (file-name-directory (url-filename base))))) 113 (setf (url-filename base) (expand-file-name url dir)) 114 (url-recreate-url base)))) 115 116(defun erldoc-parse-html (url) 117 (with-temp-buffer 118 (url-insert-file-contents url) 119 (libxml-parse-html-region (point-min) (point-max)))) 120 121(defalias 'erldoc-dom-text-node-p #'stringp) 122 123(defun erldoc-dom-attributes (dom) 124 (and (not (erldoc-dom-text-node-p dom)) (cadr dom))) 125 126(defun erldoc-dom-get-attribute (dom attrib-name) 127 (cdr (assq attrib-name (erldoc-dom-attributes dom)))) 128 129(defun erldoc-dom-children (dom) 130 (and (not (erldoc-dom-text-node-p dom)) (cddr dom))) 131 132(defun erldoc-dom-get-text (dom) 133 (let ((text (car (last (erldoc-dom-children dom))))) 134 (and (erldoc-dom-text-node-p text) text))) 135 136(defvar erldoc-dom-walk-parent nil) 137(defvar erldoc-dom-walk-siblings nil) 138 139(defun erldoc-dom-walk (dom k) 140 (funcall k dom) 141 (let ((erldoc-dom-walk-parent dom) 142 (erldoc-dom-walk-siblings (unless (erldoc-dom-text-node-p dom) 143 (cddr dom)))) 144 (dolist (child erldoc-dom-walk-siblings) 145 (erldoc-dom-walk child k)))) 146 147(defun erldoc-dom-get-element (dom element-name) 148 (catch 'return 149 (erldoc-dom-walk dom (lambda (d) 150 (when (eq (car-safe d) element-name) 151 (throw 'return d)))))) 152 153(defun erldoc-dom-get-element-by-id (dom id) 154 (catch 'return 155 (erldoc-dom-walk dom (lambda (d) 156 (when (equal (erldoc-dom-get-attribute d 'id) id) 157 (throw 'return d)))))) 158 159(defun erldoc-dom-get-elements-by-id (dom id) 160 (let (result) 161 (erldoc-dom-walk dom (lambda (d) 162 (when (equal (erldoc-dom-get-attribute d 'id) id) 163 (push d result)))) 164 (nreverse result))) 165 166(defun erldoc-fix-path (url) 167 (if (and erldoc-verify-man-path 168 ;; Could only verify local files 169 (equal (url-type (url-generic-parse-url url)) "file")) 170 (let* ((obj (url-generic-parse-url url)) 171 (new (car (file-expand-wildcards 172 (replace-regexp-in-string 173 "-[0-9]+\\(?:[.][0-9]+\\)*" "*" 174 (url-filename obj)))))) 175 (or new (error "File %s does not exist" (url-filename obj))) 176 (setf (url-filename obj) new) 177 (url-recreate-url obj)) 178 url)) 179 180(defun erldoc-parse-man-index (url) 181 (let ((table (erldoc-dom-get-element (erldoc-parse-html url) 'table)) 182 (mans)) 183 (erldoc-dom-walk 184 table 185 (lambda (d) 186 (when (eq (car-safe d) 'a) 187 (let ((href (erldoc-dom-get-attribute d 'href))) 188 (when (and href (not (string-match-p "index\\.html\\'" href))) 189 (with-demoted-errors "erldoc-parse-man-index: %S" 190 (push (cons (erldoc-dom-get-text d) 191 (erldoc-fix-path (erldoc-expand-url href url))) 192 mans))))))) 193 (nreverse mans))) 194 195(defun erldoc-parse-man (man) 196 (let ((dom (erldoc-parse-html (cdr man))) 197 (table (make-hash-table :test #'equal))) 198 (erldoc-dom-walk 199 (erldoc-dom-get-element-by-id dom "loadscrollpos") 200 (lambda (d) 201 (let ((href (erldoc-dom-get-attribute d 'href))) 202 (when (and href (string-match "#" href)) 203 (puthash (substring href (match-end 0)) 204 (list (concat (car man) ":" (erldoc-strip-string 205 (erldoc-dom-get-text d))) 206 (erldoc-expand-url href (cdr man))) 207 table))))) 208 (let ((span-content 209 (lambda (span) 210 (let ((texts)) 211 (erldoc-dom-walk span 212 (lambda (d) 213 (and (erldoc-dom-text-node-p d) 214 (push (erldoc-strip-string d) texts)))) 215 (and texts (mapconcat 'identity (nreverse texts) " "))))) 216 entries) 217 (erldoc-dom-walk 218 dom 219 (lambda (d) 220 ;; Get the full function signature. 221 (when (and (eq (car-safe d) 'a) 222 (gethash (erldoc-dom-get-attribute d 'name) table)) 223 (let* ((name (erldoc-dom-get-attribute d 'name)) 224 (mfa-url (gethash name table)) 225 (mfa (car mfa-url)) 226 (sig (or (funcall span-content d) 227 (funcall span-content 228 (or (erldoc-dom-get-element d 'span) 229 (cadr 230 (memq d erldoc-dom-walk-siblings)))) 231 (progn 232 (funcall erldoc-no-signature-function 233 "erldoc-parse-man: no sig for %s" 234 mfa) 235 nil)))) 236 (push (append mfa-url (list sig)) 237 entries))) 238 ;; Get data types 239 (when (and (eq (car-safe d) 'a) 240 (string-prefix-p "type-" 241 (or (erldoc-dom-get-attribute d 'name) ""))) 242 (push (list (concat (car man) ":" (funcall span-content d)) 243 (concat (cdr man) "#" (erldoc-dom-get-attribute d 'name)) 244 (funcall span-content erldoc-dom-walk-parent)) 245 entries)))) 246 entries))) 247 248(defun erldoc-parse-all (man-index output &optional json) 249 (let* ((output (expand-file-name output)) 250 (table (make-hash-table :size 11503 :test #'equal)) 251 (mans (erldoc-parse-man-index man-index)) 252 (progress 1) 253 (reporter (make-progress-reporter "Parsing Erlang/OTP documentation" 254 progress (length mans))) 255 fails all) 256 (dolist (man mans) 257 (condition-case err 258 (push (erldoc-parse-man man) all) 259 (error (push (error-message-string err) fails))) 260 (accept-process-output nil 0.01) 261 (progress-reporter-update reporter (cl-incf progress))) 262 (when fails 263 (display-warning 'erldoc-parse-all 264 (format "\n\n%s" (mapconcat #'identity fails "\n")) 265 :error)) 266 (progress-reporter-done reporter) 267 (mapc (lambda (x) (puthash (car x) (cdr x) table)) 268 (apply #'nconc (nreverse all))) 269 (with-temp-buffer 270 (if (not json) 271 (pp table (current-buffer)) 272 (let ((json-encoding-pretty-print t)) 273 (insert (json-encode table)))) 274 (unless (file-directory-p (file-name-directory output)) 275 (make-directory (file-name-directory output) t)) 276 (write-region nil nil output nil nil nil 'ask)))) 277 278(defun erldoc-otp-release () 279 "Get the otp release version (as string) or nil if not found." 280 (let ((otp (erldoc-dom-get-text 281 (erldoc-dom-get-element 282 (erldoc-parse-html 283 (erldoc-expand-url "index.html" erldoc-man-index)) 284 'title)))) 285 (and (string-match "[0-9.]+\\'" otp) (match-string 0 otp)))) 286 287(defvar erldoc-browse-history nil) 288(defvar erldoc-lookup-table nil) 289 290(defun erldoc-lookup-table () 291 (or erldoc-lookup-table 292 (progn 293 (unless (file-exists-p erldoc-output-file) 294 (let ((of (pcase (erldoc-otp-release) 295 (`nil erldoc-output-file) 296 (ver (concat erldoc-output-file "-" ver))))) 297 (unless (file-exists-p of) 298 (erldoc-parse-all erldoc-man-index of)) 299 (unless (string= erldoc-output-file of) 300 (make-symbolic-link (expand-file-name of) erldoc-output-file)))) 301 (setq erldoc-lookup-table 302 (with-temp-buffer 303 (insert-file-contents erldoc-output-file) 304 (read (current-buffer))))))) 305 306(defun erldoc-best-matches (mfa) 307 (pcase mfa 308 ((and `(,m ,f) (let a (erlang-get-function-arity))) 309 (let ((mfa (format "%s:%s/%s" m f a))) 310 (cond ((gethash mfa (erldoc-lookup-table)) (list mfa)) 311 (m (all-completions (concat m ":" f "/") (erldoc-lookup-table))) 312 (t (let* ((mod (erlang-get-module)) 313 (mf1 (and mod (concat mod ":" f "/"))) 314 (mf2 (concat "erlang:" f "/")) 315 (re (concat ":" (regexp-quote f) "/"))) 316 (or (and mf1 (all-completions mf1 (erldoc-lookup-table))) 317 (all-completions mf2 (erldoc-lookup-table)) 318 (cl-loop for k being the hash-keys of (erldoc-lookup-table) 319 when (string-match-p re k) 320 collect k))))))))) 321 322;;;###autoload 323(defun erldoc-browse (mfa) 324 (interactive 325 (let ((default 326 ;; `erlang-mode-syntax-table' is lazily initialised. 327 (with-syntax-table (or erlang-mode-syntax-table (standard-syntax-table)) 328 (ignore-errors 329 (erldoc-best-matches 330 (or (erlang-get-function-under-point) 331 (save-excursion 332 (goto-char (or (cadr (syntax-ppss)) (point))) 333 (erlang-get-function-under-point)))))))) 334 (list (completing-read (format (if default "Function {%d %s} (default %s): " 335 "Function: ") 336 (length default) 337 (if (= (length default) 1) "guess" "guesses") 338 (car default)) 339 (erldoc-lookup-table) 340 nil t nil 'erldoc-browse-history default)))) 341 (or (stringp mfa) 342 (signal 'wrong-type-argument (list 'string mfa 'mfa))) 343 (browse-url (or (car (gethash mfa (erldoc-lookup-table))) 344 (user-error "No documentation for %s" mfa)))) 345 346;;;###autoload 347(defun erldoc-apropos (pattern) 348 (interactive "sPattern: ") 349 (with-help-window (help-buffer) 350 (with-current-buffer standard-output 351 (princ (concat "Erldoc apropos pattern: " pattern "\n\n")) 352 (maphash (lambda (k v) 353 (when (string-match-p pattern k) 354 (insert-text-button k :type 'help-url 355 'help-args (list (car v))) 356 (insert "\n"))) 357 (erldoc-lookup-table))))) 358 359(defun erldoc-tokenize-signature (sig) 360 ;; Divide SIG into (MF ARGLIST RETTYPE) 361 (let ((from (if (string-match "\\`.+?(" sig) 362 (1- (match-end 0)) 363 0)) 364 (to (and (string-match "\\s-*->\\s-*.*?\\'" sig) (match-beginning 0)))) 365 (list (erldoc-strip-string (substring sig 0 from)) 366 (erldoc-strip-string (substring sig from (and to (max from to)))) 367 (and to (erldoc-strip-string (substring sig to)))))) 368 369(defun erldoc-format-signature (mod fn) 370 (when (and mod fn (or erldoc-lookup-table 371 (file-exists-p erldoc-output-file))) 372 (let ((re (concat "\\`" mod ":" fn "/\\([0-9]+\\)\\'")) 373 (sigs)) 374 (maphash (lambda (k v) 375 (when (string-match re k) 376 (if (cadr v) 377 (push (cons (string-to-number (match-string 1 k)) 378 (cdr (erldoc-tokenize-signature (cadr v)))) 379 sigs) 380 (funcall erldoc-no-signature-function 381 "erldoc-format-signature: No sig for %s" k)))) 382 (erldoc-lookup-table)) 383 (when sigs 384 ;; Mostly single return type but there are exceptions such as 385 ;; `beam_lib:chunks/2,3'. 386 (let ((single-rettype 387 (cl-reduce (lambda (x1 x2) (and x1 x2 (equal x1 x2) x1)) 388 sigs :key #'cl-caddr)) 389 (sigs (sort sigs #'car-less-than-car))) 390 (if single-rettype 391 (concat mod ":" fn (mapconcat #'cadr sigs " | ") " " single-rettype) 392 (mapconcat (lambda (x) (concat mod ":" fn (nth 1 x) " " (nth 2 x))) 393 sigs "\n"))))))) 394 395;;;###autoload 396(defun erldoc-eldoc-function () 397 "A function suitable for `eldoc-documentation-function'." 398 (save-excursion 399 (pcase (erlang-get-function-under-point) 400 (`(,_ nil) ) 401 (`(nil ,fn) (erldoc-format-signature "erlang" fn)) 402 (`(,mod ,fn) (erldoc-format-signature mod fn))))) 403 404(defun erldoc-parse-eeps-index () 405 (let* ((url "http://www.erlang.org/eeps/") 406 (table (catch 'return 407 (erldoc-dom-walk (erldoc-parse-html url) 408 (lambda (d) 409 (and (eq (car-safe d) 'table) 410 (equal (erldoc-dom-get-attribute d 'summary) 411 "Numerical Index of EEPs") 412 (throw 'return d)))))) 413 (fix-title (lambda (title) 414 (replace-regexp-in-string 415 "`` *" "" (replace-regexp-in-string " *``, *" " by " title)))) 416 (result)) 417 (erldoc-dom-walk 418 table (lambda (d) 419 (when (eq (car-safe d) 'a) 420 (push (cons (funcall fix-title (erldoc-dom-get-attribute d 'title)) 421 (erldoc-expand-url 422 (erldoc-dom-get-attribute d 'href) 423 url)) 424 result)))) 425 (nreverse result))) 426 427(defvar erldoc-user-guides nil) 428 429(defvar erldoc-missing-user-guides 430 '("compiler" "hipe" "kernel" "os_mon" "parsetools") 431 "List of standard Erlang applications with no user guides.") 432 433;; Search in `code:lib_dir/0' using find LIB_DIR -type f -name 434;; '*_app.html'. 435(defvar erldoc-app-manuals '("crypto" "diameter" "erl_docgen" 436 "kernel" "observer" "os_mon" 437 "runtime_tools" "sasl" "snmp" 438 "ssl" "test_server" 439 ("ssh" . "SSH") ("stdlib" . "STDLIB") 440 ("hipe" . "HiPE")) 441 "List of applications that come with a manual.") 442 443(defun erldoc-user-guide-chapters (user-guide) 444 (pcase-let ((`(,name . ,url) user-guide)) 445 (unless (member name erldoc-missing-user-guides) 446 (let ((chaps (erldoc-dom-get-elements-by-id 447 (erldoc-dom-get-element-by-id (erldoc-parse-html url) "leftnav") 448 "no"))) 449 (or chaps (warn "erldoc-user-guide-chapters no chapters found for `%s'" 450 (cdr user-guide))) 451 (mapcar (lambda (li) 452 (cons (concat name "#" (erldoc-dom-get-attribute li 'title)) 453 (erldoc-expand-url (erldoc-dom-get-attribute 454 (erldoc-dom-get-element li 'a) 'href) 455 url))) 456 chaps))))) 457 458(defun erldoc-user-guides-1 () 459 (let ((url (erldoc-expand-url "applications.html" erldoc-man-index)) 460 app-guides app-mans) 461 (erldoc-dom-walk 462 (erldoc-parse-html url) 463 (lambda (d) 464 (when (and (eq (car-safe d) 'a) 465 (not (string-match-p "\\`[0-9.]+\\'" (erldoc-dom-get-text d)))) 466 (with-demoted-errors "erldoc-user-guides-1: %S" 467 (let ((name (erldoc-strip-string (erldoc-dom-get-text d))) 468 (index-page (erldoc-fix-path (erldoc-expand-url 469 (erldoc-dom-get-attribute d 'href) url)))) 470 (push (cons name (if (member name erldoc-missing-user-guides) 471 index-page 472 (erldoc-expand-url "users_guide.html" index-page))) 473 app-guides) 474 ;; Collect application manuals. 475 (pcase (assoc name (mapcar (lambda (x) (if (consp x) x (cons x x))) 476 erldoc-app-manuals)) 477 (`(,_ . ,manual) 478 (push (cons name 479 (erldoc-expand-url (format "%s_app.html" manual) 480 index-page)) 481 app-mans)))))))) 482 (list (nreverse app-guides) 483 (nreverse app-mans)))) 484 485(defun erldoc-user-guides () 486 (or erldoc-user-guides 487 (let ((file (concat erldoc-output-file "-topics"))) 488 (unless (file-exists-p file) 489 (unless (file-directory-p (file-name-directory file)) 490 (make-directory (file-name-directory file) t)) 491 (with-temp-buffer 492 (pcase-let ((`(,guides ,mans) (erldoc-user-guides-1))) 493 (pp (append (cl-mapcan #'erldoc-user-guide-chapters 494 (append (mapcar 495 (lambda (dir) 496 (cons dir (erldoc-expand-url 497 (concat dir "/users_guide.html") 498 erldoc-man-index))) 499 '("design_principles" 500 "efficiency_guide" 501 "embedded" 502 "getting_started" 503 "installation_guide" 504 "oam" 505 "programming_examples" 506 "reference_manual" 507 "system_architecture_intro" 508 "system_principles" 509 "tutorial")) 510 guides)) 511 (mapcar (lambda (man) 512 (pcase-let ((`(,name . ,url) man)) 513 (cons (concat name " (App)") url))) 514 mans) 515 (erldoc-parse-eeps-index)) 516 (current-buffer))) 517 (write-region nil nil file nil nil nil 'ask))) 518 (setq erldoc-user-guides (with-temp-buffer (insert-file-contents file) 519 (read (current-buffer))))))) 520 521;;;###autoload 522(defun erldoc-browse-topic (topic) 523 (interactive 524 (list (completing-read "User guide: " (erldoc-user-guides) nil t))) 525 (browse-url (cdr (assoc topic (erldoc-user-guides))))) 526 527(provide 'erldoc) 528 529;; Local variables: 530;; coding: utf-8 531;; indent-tabs-mode: nil 532;; End: 533 534;;; erldoc.el ends here 535