From mboxrd@z Thu Jan 1 00:00:00 1970 From: John Kitchin Subject: colored-links take 2 Date: Thu, 30 Jun 2016 13:56:15 -0400 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:37410) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bIgCR-0004Or-6F for emacs-orgmode@gnu.org; Thu, 30 Jun 2016 13:56:28 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bIgCL-0008Db-Hz for emacs-orgmode@gnu.org; Thu, 30 Jun 2016 13:56:26 -0400 Received: from mail-qk0-x22c.google.com ([2607:f8b0:400d:c09::22c]:36798) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bIgCL-0008DQ-DF for emacs-orgmode@gnu.org; Thu, 30 Jun 2016 13:56:21 -0400 Received: by mail-qk0-x22c.google.com with SMTP id j2so105262968qkf.3 for ; Thu, 30 Jun 2016 10:56:21 -0700 (PDT) Received: from Johns-MacBook-Air.local (KITCHIN-TIMEMACHINE.CHEME.CMU.EDU. [128.2.54.215]) by smtp.gmail.com with ESMTPSA id g69sm2278841qke.47.2016.06.30.10.56.17 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Thu, 30 Jun 2016 10:56:18 -0700 (PDT) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: "emacs-orgmode@gnu.org" --=-=-= Content-Type: text/plain I forgot a little piece in the last patch. This one is probably right. It is based off of https://github.com/jkitchin/org-mode/blob/colored-link-3. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=colored-link.patch diff --git a/lisp/org.el b/lisp/org.el index 89b72bc..451a668 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1867,6 +1867,18 @@ return the description to use." :tag "Org Store Link" :group 'org-link) +(defcustom org-link-display-parameters nil + "An alist of properties to display a link with. +The first element in each list is a string of the link +type. Subsequent optional elements make up a p-list. :face can be +used to change the face on the link (the default is +`org-link'. If :display is 'full the full link will show in +descriptive link mode." + :type '(alist :tag "Link display paramters" + :key-type 'string + :value-type '(plist)) + :group 'org-link) + (defcustom org-url-hexify-p t "When non-nil, hexify URL when creating a link." :type 'boolean @@ -5864,14 +5876,19 @@ prompted for." "Add link properties for plain links." (when (and (re-search-forward org-plain-link-re limit t) (not (org-in-src-block-p))) + (let ((face (get-text-property (max (1- (match-beginning 0)) (point-min)) 'face)) - (link (match-string-no-properties 0))) + (link (match-string-no-properties 0)) + (type (match-string-no-properties 1))) (unless (if (consp face) (memq 'org-tag face) (eq 'org-tag face)) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight - 'face 'org-link + 'face (or (plist-get + (cdr (assoc type org-link-display-parameters)) + :face) + 'org-link) 'htmlize-link `(:uri ,link) 'keymap org-mouse-map)) (org-rear-nonsticky-at (match-end 0)) @@ -6064,8 +6081,14 @@ by a #." (when (and (re-search-forward org-bracket-link-regexp limit t) (not (org-in-src-block-p))) (let* ((hl (match-string-no-properties 1)) + (type (save-match-data + (string-match "\\(.*?\\):" hl) + (match-string 1 hl))) (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) - (ip (list 'invisible 'org-link + (ip (list 'invisible (or (plist-get + (cdr (assoc type org-link-display-parameters)) + :display) + 'org-link) 'keymap org-mouse-map 'mouse-face 'highlight 'font-lock-multiline t 'help-echo help 'htmlize-link `(:uri ,hl))) @@ -6362,8 +6385,8 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Links (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (when (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (when (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (when (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) + (when (memq 'plain lk) '(org-activate-plain-links (0 'org-link))) + (when (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link))) (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t))) (when (memq 'date lk) '(org-activate-dates (0 'org-date t))) (when (memq 'footnote lk) '(org-activate-footnote-links)) --=-=-= Content-Type: text/plain -- Professor John Kitchin Doherty Hall A207F Department of Chemical Engineering Carnegie Mellon University Pittsburgh, PA 15213 412-268-7803 @johnkitchin http://kitchingroup.cheme.cmu.edu --=-=-=--