elfeed-lib.el (14500B)
1 ;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*- 2 3 ;; This is free and unencumbered software released into the public domain. 4 5 ;;; Commentary: 6 7 ;; These are general functions that aren't specific to web feeds. It's 8 ;; a library of useful functions to Elfeed. 9 10 ;;; Code: 11 12 (require 'cl-lib) 13 (require 'thingatpt) 14 (require 'time-date) 15 (require 'url-parse) 16 (require 'url-util) 17 (require 'xml) 18 19 (defun elfeed-expose (function &rest args) 20 "Return an interactive version of FUNCTION, 'exposing' it to the user." 21 (lambda () (interactive) (apply function args))) 22 23 (defun elfeed-goto-line (n) 24 "Like `goto-line' but for non-interactive use." 25 (goto-char (point-min)) 26 (forward-line (1- n))) 27 28 (defun elfeed-kill-buffer () 29 "Kill the current buffer." 30 (interactive) 31 (kill-buffer (current-buffer))) 32 33 (defun elfeed-kill-line () 34 "Clear out the current line without touching anything else." 35 (beginning-of-line) 36 (let ((start (point))) 37 (end-of-line) 38 (delete-region start (point)))) 39 40 (defun elfeed-time-duration (time &optional now) 41 "Turn a time expression into a number of seconds. Uses 42 `timer-duration' but allows a bit more flair. 43 44 If `now' is non-nil, use it as the current time (`float-time'). This 45 is mostly useful for testing." 46 (cond 47 ((numberp time) time) 48 ((let ((iso-time (elfeed-parse-simple-iso-8601 time))) 49 (when iso-time (- (or now (float-time)) iso-time)))) 50 ((string-match-p "[[:alpha:]]" time) 51 (let* ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)) 52 (duration (timer-duration clean))) 53 ;; convert to float since float-time is used elsewhere 54 (when duration (float duration)))))) 55 56 (defun elfeed-looks-like-url-p (string) 57 "Return true if STRING looks like it could be a URL." 58 (and (stringp string) 59 (not (string-match-p "[ \n\t\r]" string)) 60 (not (null (url-type (url-generic-parse-url string)))))) 61 62 (defun elfeed-format-column (string width &optional align) 63 "Return STRING truncated or padded to WIDTH following ALIGNment. 64 Align should be a keyword :left or :right." 65 (if (<= width 0) 66 "" 67 (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width) 68 string))) 69 70 (defun elfeed-clamp (min value max) 71 "Clamp a value between two values." 72 (min max (max min value))) 73 74 (defun elfeed-valid-regexp-p (regexp) 75 "Return t if REGEXP is a valid REGEXP." 76 (ignore-errors 77 (prog1 t 78 (string-match-p regexp "")))) 79 80 (defun elfeed-cleanup (name) 81 "Trim trailing and leading spaces and collapse multiple spaces." 82 (let ((trim (replace-regexp-in-string "[\f\n\r\t\v ]+" " " (or name "")))) 83 (replace-regexp-in-string "^ +\\| +$" "" trim))) 84 85 (defun elfeed-parse-simple-iso-8601 (string) 86 "Attempt to parse STRING as a simply formatted ISO 8601 date. 87 Examples: 2015-02-22, 2015-02, 20150222" 88 (let* ((re (cl-flet ((re-numbers (num) (format "\\([0-9]\\{%s\\}\\)" num))) 89 (format "^%s-?%s-?%s?\\(T%s:%s:?%s?\\)?" 90 (re-numbers 4) 91 (re-numbers 2) 92 (re-numbers 2) 93 (re-numbers 2) 94 (re-numbers 2) 95 (re-numbers 2)))) 96 (matches (save-match-data 97 (when (string-match re string) 98 (cl-loop for i from 1 to 7 99 collect (let ((match (match-string i string))) 100 (and match (string-to-number match)))))))) 101 (when matches 102 (cl-multiple-value-bind (year month day _ hour min sec) matches 103 (float-time (encode-time (or sec 0) (or min 0) (or hour 0) 104 (or day 1) month year t)))))) 105 106 (defun elfeed-new-date-for-entry (old-date new-date) 107 "Decide entry date, given an existing date (nil for new) and a new date. 108 Existing entries' dates are unchanged if the new date is not 109 parseable. New entries with unparseable dates default to the 110 current time." 111 (or (elfeed-float-time new-date) 112 old-date 113 (float-time))) 114 115 (defun elfeed-float-time (date) 116 "Like `float-time' but accept anything reasonable for DATE. 117 Defaults to nil if DATE could not be parsed. Date is allowed to 118 be relative to now (`elfeed-time-duration')." 119 (cl-typecase date 120 (string 121 (let ((iso-8601 (elfeed-parse-simple-iso-8601 date))) 122 (if iso-8601 123 iso-8601 124 (let ((duration (elfeed-time-duration date))) 125 (if duration 126 (- (float-time) duration) 127 (let ((time (ignore-errors (date-to-time date)))) 128 ;; check if date-to-time failed, silently or otherwise 129 (unless (or (null time) (equal time '(14445 17280))) 130 (float-time time)))))))) 131 (integer date) 132 (otherwise nil))) 133 134 (defun elfeed-xml-parse-region (&optional beg end buffer parse-dtd _parse-ns) 135 "Decode (if needed) and parse XML file. Uses coding system from 136 XML encoding declaration." 137 (unless beg (setq beg (point-min))) 138 (unless end (setq end (point-max))) 139 (setf (point) beg) 140 (when (re-search-forward 141 "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t) 142 (let ((coding-system (intern-soft (downcase (match-string 1))))) 143 (when (ignore-errors (check-coding-system coding-system)) 144 (let ((mark-beg (make-marker)) 145 (mark-end (make-marker))) 146 ;; Region changes with encoding, so use markers to track it. 147 (set-marker mark-beg beg) 148 (set-marker mark-end end) 149 (set-buffer-multibyte t) 150 (recode-region mark-beg mark-end coding-system 'raw-text) 151 (setf beg (marker-position mark-beg) 152 end (marker-position mark-end)))))) 153 (let ((xml-default-ns ())) 154 (xml-parse-region beg end buffer parse-dtd 'symbol-qnames))) 155 156 (defun elfeed-xml-unparse (element) 157 "Inverse of `elfeed-xml-parse-region', writing XML to the buffer." 158 (cl-destructuring-bind (tag attrs . body) element 159 (insert (format "<%s" tag)) 160 (dolist (attr attrs) 161 (cl-destructuring-bind (key . value) attr 162 (insert (format " %s='%s'" key (xml-escape-string value))))) 163 (if (null body) 164 (insert "/>") 165 (insert ">") 166 (dolist (sub body) 167 (if (stringp sub) 168 (insert (xml-escape-string sub)) 169 (elfeed-xml-unparse sub))) 170 (insert (format "</%s>" tag))))) 171 172 (defun elfeed-directory-empty-p (dir) 173 "Return non-nil if DIR is empty." 174 (null (cddr (directory-files dir)))) 175 176 (defun elfeed-slurp (file &optional literally) 177 "Return the contents of FILE as a string." 178 (with-temp-buffer 179 (if literally 180 (insert-file-contents-literally file) 181 (insert-file-contents file)) 182 (buffer-string))) 183 184 (cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8)) 185 "Write STRING to FILE." 186 (let ((coding-system-for-write encoding) 187 (write-region-inhibit-fsync (not fsync))) 188 (with-temp-buffer 189 (insert string) 190 (write-region nil nil file append 0)))) 191 192 (defvar elfeed-gzip-supported-p--cache :unknown 193 "To avoid running the relatively expensive test more than once.") 194 195 (defun elfeed-gzip-supported-p () 196 "Return non-nil if `auto-compression-mode' can handle gzip." 197 (if (not (eq elfeed-gzip-supported-p--cache :unknown)) 198 elfeed-gzip-supported-p--cache 199 (setf elfeed-gzip-supported-p--cache 200 (and (executable-find "gzip") 201 (ignore-errors 202 (save-window-excursion 203 (let ((file (make-temp-file "gziptest" nil ".gz")) 204 (data (cl-loop for i from 32 to 3200 205 collect i into chars 206 finally 207 (return (apply #'string chars))))) 208 (unwind-protect 209 (progn 210 (elfeed-spit file data) 211 (and (string= data (elfeed-slurp file)) 212 (not (string= data (elfeed-slurp file t))))) 213 (delete-file file))))))))) 214 215 (defun elfeed-libxml-supported-p () 216 "Return non-nil if `libxml-parse-html-region' is available." 217 (with-temp-buffer 218 (insert "<html></html>") 219 (and (fboundp 'libxml-parse-html-region) 220 (not (null (libxml-parse-html-region (point-min) (point-max))))))) 221 222 (defun elfeed-keyword->symbol (keyword) 223 "If a keyword, convert KEYWORD into a plain symbol (remove the colon)." 224 (if (keywordp keyword) 225 (intern (substring (symbol-name keyword) 1)) 226 keyword)) 227 228 (defun elfeed-resize-vector (vector length) 229 "Return a copy of VECTOR set to size LENGTH." 230 (let ((new-vector (make-vector length nil))) 231 (prog1 new-vector ; don't use dotimes result (bug#16206) 232 (dotimes (i (min (length new-vector) (length vector))) 233 (setf (aref new-vector i) (aref vector i)))))) 234 235 (defun elfeed-readable-p (value) 236 "Return non-nil if VALUE can be serialized." 237 (condition-case _ 238 (prog1 t (read (prin1-to-string value))) 239 (error nil))) 240 241 (defun elfeed-strip-properties (string) 242 "Return a copy of STRING with all properties removed. 243 If STRING is nil, returns nil." 244 (when string 245 (let ((copy (copy-sequence string))) 246 (prog1 copy 247 (set-text-properties 0 (length copy) nil copy))))) 248 249 (defun elfeed-clipboard-get () 250 "Try to get a sensible value from the system clipboard. 251 On systems running X, it will try to use the PRIMARY selection 252 first, then fall back onto the standard clipboard like other 253 systems." 254 (elfeed-strip-properties 255 (or (and (fboundp 'x-get-selection) 256 (funcall 'x-get-selection)) 257 (and (functionp interprogram-paste-function) 258 (funcall interprogram-paste-function)) 259 (and (fboundp 'w32-get-clipboard-data) 260 (funcall 'w32-get-clipboard-data)) 261 (ignore-errors 262 (current-kill 0 :non-destructively))))) 263 264 (defun elfeed-get-link-at-point () 265 "Try to a link at point and return its URL." 266 (or (get-text-property (point) 'shr-url) 267 (and (fboundp 'eww-current-url) 268 (funcall 'eww-current-url)) 269 (get-text-property (point) :nt-link))) 270 271 (defun elfeed-get-url-at-point () 272 "Try to get a plain URL at point." 273 (or (if (fboundp 'thing-at-point-url-at-point) 274 (thing-at-point-url-at-point) 275 (with-no-warnings (url-get-url-at-point))) 276 (thing-at-point 'url))) 277 278 (defun elfeed-move-to-first-empty-line () 279 "Place point after first blank line, for use with `url-retrieve'. 280 If no such line exists, point is left in place." 281 (let ((start (point))) 282 (setf (point) (point-min)) 283 (unless (search-forward-regexp "^$" nil t) 284 (setf (point) start)))) 285 286 (defun elfeed--shuffle (seq) 287 "Destructively shuffle SEQ." 288 (let ((n (length seq))) 289 (prog1 seq ; don't use dotimes result (bug#16206) 290 (dotimes (i n) 291 (cl-rotatef (elt seq i) (elt seq (+ i (cl-random (- n i))))))))) 292 293 (defun elfeed-split-ranges-to-numbers (str n) 294 "Convert STR containing enclosure numbers into a list of numbers. 295 STR is a string; N is the highest possible number in the list. 296 This includes expanding e.g. 3-5 into 3,4,5. If the letter 297 \"a\" ('all')) is given, that is expanded to a list with numbers [1..n]." 298 (let ((str-split (split-string str)) 299 beg end list) 300 (dolist (elem str-split list) 301 ;; special number "a" converts into all enclosures 1-N. 302 (when (equal elem "a") 303 (setf elem (concat "1-" (int-to-string n)))) 304 (if (string-match "\\([0-9]+\\)-\\([0-9]+\\)" elem) 305 ;; we have found a range A-B, which needs converting 306 ;; into the numbers A, A+1, A+2, ... B. 307 (progn 308 (setf beg (string-to-number (match-string 1 elem)) 309 end (string-to-number (match-string 2 elem))) 310 (while (<= beg end) 311 (setf list (nconc list (list beg)) 312 beg (1+ beg)))) 313 ;; else just a number 314 (push (string-to-number elem) list))))) 315 316 (defun elfeed-remove-dot-segments (input) 317 "Relative URL algorithm as described in RFC 3986 ยง5.2.4." 318 (cl-loop 319 with output = "" 320 for s = input 321 then (cond 322 ((string-match-p "^\\.\\./" s) 323 (substring s 3)) 324 ((string-match-p "^\\./" s) 325 (substring s 2)) 326 ((string-match-p "^/\\./" s) 327 (substring s 2)) 328 ((string-match-p "^/\\.$" s) "/") 329 ((string-match-p "^/\\.\\./" s) 330 (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) 331 (substring s 3)) 332 ((string-match-p "^/\\.\\.$" s) 333 (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) 334 "/") 335 ((string-match-p "^\\.\\.?$" s) 336 "") 337 ((string-match "^/?[^/]*" s) 338 (setf output (concat output (match-string 0 s))) 339 (replace-regexp-in-string "^/?[^/]*" "" s))) 340 until (zerop (length s)) 341 finally return output)) 342 343 (defun elfeed-update-location (old-url new-url) 344 "Return full URL for maybe-relative NEW-URL based on full OLD-URL." 345 (if (null new-url) 346 old-url 347 (let ((old (url-generic-parse-url old-url)) 348 (new (url-generic-parse-url new-url))) 349 (cond 350 ;; Is new URL absolute already? 351 ((url-type new) new-url) 352 ;; Empty is a special case (clear fragment) 353 ((equal new-url "") 354 (setf (url-target old) nil) 355 (url-recreate-url old)) 356 ;; Does it start with //? Append the old protocol. 357 ((url-fullness new) (concat (url-type old) ":" new-url)) 358 ;; Is it a relative path? 359 ((not (string-match-p "^/" new-url)) 360 (let* ((old-dir (or (file-name-directory (url-filename old)) "/")) 361 (concat (concat old-dir new-url)) 362 (new-file (elfeed-remove-dot-segments concat))) 363 (setf (url-filename old) nil 364 (url-target old) nil 365 (url-attributes old) nil 366 (url-filename old) new-file) 367 (url-recreate-url old))) 368 ;; Replace the relative part. 369 ((progn 370 (setf (url-filename old) (elfeed-remove-dot-segments new-url) 371 (url-target old) nil 372 (url-attributes old) nil) 373 (url-recreate-url old))))))) 374 375 (defun elfeed-url-to-namespace (url) 376 "Compute an ID namespace from URL." 377 (let* ((urlobj (url-generic-parse-url url)) 378 (host (url-host urlobj))) 379 (if (= 0 (length host)) 380 url 381 host))) 382 383 (provide 'elfeed-lib) 384 385 ;;; elfeed-lib.el ends here