[Arcana] Feeling pretty clever.

Karl Fogel kfogel at red-bean.com
Thu Nov 3 16:18:31 CDT 2011


Feeling pretty clever :-).  I'm going to blog about this at some point,
so I have something to point to when people ask "Why do you use Emacs?",
but I couldn't resist sending it to you first.  After evaluating, run
`M-x kf-url-opensource.org/faq' and all will become clear.  Note it can
generate a similar function for any web page.  <evil grin>

(defun kf-get-anchors (url)
  "Return a completion table for all identifiably outward anchors at URL.

An \"identifiably outward\" anchor is any anchor that looks like
it's meant to be used in publicly displayed URLs pointing into
the page, e.g., \"http://opensource.org/faq#commercial\", as
contrasted with, say, ID elements that are really only meant to be
targeted by Javascript or other DOM-aware code.

There is no 100% reliable way to distinguish between these two
kinds of anchors.  The heuristic we use is that if an element has
both \"id\" and \"title\" attributes with the same value, it's an
identifiably outward anchor.  And we're not really parsing the HTML,
we're just looking for the attributes in that order on the same line;
patches welcome.

Returns an alist mapping anchors to full, anchored urls, i.e.:

  `((\"ANCHOR-NAME\" . \"http://FQDN/ETC/PAGE#ANCHOR-NAME\") ...)'
"
  (require 'url)
  (let ((anchors ()))
  (save-excursion
    (set-buffer (url-retrieve-synchronously url))
    (goto-char (point-min))
    (save-match-data
      (while (re-search-forward " id=\"\\([a-zA-Z0-9_.-]+\\)\" title=\"\\([a-zA-Z0-9_.-]+\\)\"" nil t)
        (let ((id-val (match-string-no-properties 1))
              (title-val (match-string-no-properties 2)))
          (when (string-equal id-val title-val)
            (setq anchors (cons id-val anchors))))))
    (mapcar (lambda (anchor) (cons anchor (concat url "#" anchor))) anchors))))

(defun kf-insert-anchored-url-from-url (base-url)
  "Insert an anchored url, starting from BASE-URL.
Interactively read the anchor name from the user, completing based on
the anchors available in the web page.  Return the full (anchored) url.

See `kf-get-anchors' for more about identifying anchors."
  (interactive)
  (let* ((anchor-alist (kf-get-anchors base-url))
         (full-url (cdr (assoc
                         (completing-read (concat base-url "#") anchor-alist)
                         anchor-alist))))
    (insert full-url)
    full-url))

(defmacro kf-make-url-generator (url)
  "Generate a new interactive function to insert a URL with an anchor name.
The function's name will be `kf-url-' followed by the unique portion of
the URL.  It will fetch anchors from the web page, prompt the user 
completingly for an anchor name, then insert the full anchored url."
  (let ((url-unique-portion
         (save-match-data
           (string-match "https?://\\([a-zA-Z0-9/.-]+\\)" url)
           (match-string-no-properties 1 url))))
    `(defun ,(intern (concat "kf-url-" url-unique-portion)) ()
       ,(format 
         "%s%s%s%s%s%s"
         "Insert an anchored url, starting from \"" url "#\"\n"
         "and completing based on available named anchors in that page.\n"
         "\n"
         "(This function was generated by `kf-make-url-generator';\n"
         "see also `kf-insert-anchored-url-from-url'.)")
       (interactive)
       (kf-insert-anchored-url-from-url ,url))))

(kf-make-url-generator "http://opensource.org/faq")




More information about the Arcana mailing list