Function: org--confirm-resource-safe

org--confirm-resource-safe is a byte-compiled function defined in org.el.gz.

Signature

(org--confirm-resource-safe URI)

Documentation

Ask the user if URI should be considered safe, returning non-nil if so.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(defun org--confirm-resource-safe (uri)
  "Ask the user if URI should be considered safe, returning non-nil if so."
  (unless noninteractive
    (let ((current-file (and (buffer-file-name (buffer-base-buffer))
                             (file-truename (buffer-file-name (buffer-base-buffer)))))
          (domain (and (string-match
                        (rx (seq "http" (? "s") "://")
                            (optional (+ (not (any "@/\n"))) "@")
                            (optional "www.")
                            (one-or-more (not (any ":/?\n"))))
                        uri)
                       (match-string 0 uri)))
          (buf (get-buffer-create "*Org Remote Resource*")))
      ;; Set up the contents of the *Org Remote Resource* buffer.
      (with-current-buffer buf
        (erase-buffer)
        (insert "An org-mode document would like to download "
                (propertize uri 'face '(:inherit org-link :weight normal))
                ", which is not considered safe.\n\n"
                "Do you want to download this?  You can type\n "
                (propertize "!" 'face 'success)
                " to download this resource, and permanently mark it as safe.\n "
                (if domain
                    (concat
                     (propertize "d" 'face 'success)
                     " to download this resource, and mark the domain ("
                     (propertize domain 'face '(:inherit org-link :weight normal))
                     ") as safe.\n ")
                  "")
                (if current-file
                    (concat
                     (propertize "f" 'face 'success)
                     " to download this resource, and permanently mark all resources in "
                     (propertize current-file 'face 'underline)
                     " as safe.\n ")
                  "")
                (propertize "y" 'face 'warning)
                " to download this resource, just this once.\n "
                (propertize "n" 'face 'error)
                " to skip this resource.\n")
        (setq-local cursor-type nil)
        (set-buffer-modified-p nil)
        (goto-char (point-min)))
      ;; Display the buffer and read a choice.
      (save-window-excursion
        (pop-to-buffer buf)
        (let* ((exit-chars (append '(?y ?n ?! ?d ?\s) (and current-file '(?f))))
               (prompt (format "Please type y, n%s, d, or !%s: "
                               (if current-file ", f" "")
                               (if (< (line-number-at-pos (point-max))
                                      (window-body-height))
                                   ""
                                 ", or C-v/M-v to scroll")))
               char)
          (setq char (read-char-choice prompt exit-chars))
          (when (memq char '(?! ?f ?d))
            (customize-push-and-save
             'org-safe-remote-resources
             (list (if (eq char ?d)
                       (concat "\\`" (regexp-quote domain) "\\(?:/\\|\\'\\)")
                     (concat "\\`"
                             (regexp-quote
                              (if (and (= char ?f) current-file)
                                  (concat "file://" current-file) uri))
                             "\\'")))))
          (prog1 (memq char '(?y ?! ?d ?\s ?f))
            (quit-window t)))))))