From mboxrd@z Thu Jan 1 00:00:00 1970 From: John Kitchin Subject: Re: patch for custom colored links in org-mode Date: Thu, 30 Jun 2016 13:44:26 -0400 Message-ID: References: <87twgdxtfm.fsf@saiph.selenimh> <87twga28j8.fsf@saiph.selenimh> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:34534) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bIg0x-0001rD-7r for emacs-orgmode@gnu.org; Thu, 30 Jun 2016 13:44:36 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bIg0t-000532-0X for emacs-orgmode@gnu.org; Thu, 30 Jun 2016 13:44:34 -0400 Received: from mail-qt0-x236.google.com ([2607:f8b0:400d:c0d::236]:33300) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bIg0s-00052x-Qb for emacs-orgmode@gnu.org; Thu, 30 Jun 2016 13:44:30 -0400 Received: by mail-qt0-x236.google.com with SMTP id c34so46366064qte.0 for ; Thu, 30 Jun 2016 10:44:30 -0700 (PDT) In-reply-to: <87twga28j8.fsf@saiph.selenimh> 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: Nicolas Goaziou Cc: org mode --=-=-= Content-Type: text/plain I think I have attached the right patch that does this. Let me know what you think. Nicolas Goaziou writes: > Hello, > > John Kitchin writes: > >> I took a stab at this implementation here: >> >> https://github.com/jkitchin/org-mode/compare/master...colored-link-2?expand=1 > > Thank you. > > Could you send the patch on the ML instead? It is better for commenting > and archiving. Also make sure to patch against master branch (e.g. > `org-match-string-no-properties' -> 'match-string-no-properties'). > > > Regards, -- 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=colored-link.patch diff --git a/lisp/org.el b/lisp/org.el index 89b72bc..48b6748 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)) @@ -6065,7 +6082,10 @@ by a #." (not (org-in-src-block-p))) (let* ((hl (match-string-no-properties 1)) (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 +6382,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)) --=-=-=--