aliens/org-contacts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix most of the compiler wanrings and add `Version:'

Browse source 
> I have get response from Strey, he said he has requested FSF for
> signing paperwork, should be ready in days.

In the mean time, here's a patch which addresses most of the compiler
warnings I got.  It also adds a `Version:` since that'll be necessary
for the package to be released on GNU ELPA.  And it furthermore adds
a few FIXMEs which you might want to look at.

        Stefan
This commit is contained in:
Stefan Monnier 2021-11-17 15:48:18 -05:00 committed by stardiviner
parent f64d6edcd0
commit 3e075cdee4
1 changed files with 78 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

156
org-contacts.el
View file

@ -1,10 +1,11 @@
;;; org-contacts.el --- Contacts management ;;; org-contacts.el --- Contacts management -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2014, 2021 Julien Danjou <julien@danjou.info> ;; Copyright (C) 2010-2014, 2021 Julien Danjou <julien@danjou.info>
;; Author: Julien Danjou <julien@danjou.info> ;; Author: Julien Danjou <julien@danjou.info>
;; Maintainer: stardiviner <numbchild@gmail.com> ;; Maintainer: stardiviner <numbchild@gmail.com>
;; Keywords: contacts, org-mode, outlines, hypermedia, calendar ;; Keywords: contacts, org-mode, outlines, hypermedia, calendar
;; Version: 0
;; ;;
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
;; ;;
@ -77,44 +78,36 @@
(defcustom org-contacts-files nil (defcustom org-contacts-files nil
"List of Org files to use as contacts source. "List of Org files to use as contacts source.
When set to nil, all your Org files will be used." When set to nil, all your Org files will be used."
:type '(repeat file) :type '(repeat file))
:group 'org-contacts)
(defcustom org-contacts-email-property "EMAIL" (defcustom org-contacts-email-property "EMAIL"
"Name of the property for contact email address." "Name of the property for contact email address."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-tel-property "PHONE" (defcustom org-contacts-tel-property "PHONE"
"Name of the property for contact phone number." "Name of the property for contact phone number."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-address-property "ADDRESS" (defcustom org-contacts-address-property "ADDRESS"
"Name of the property for contact address." "Name of the property for contact address."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-birthday-property "BIRTHDAY" (defcustom org-contacts-birthday-property "BIRTHDAY"
"Name of the property for contact birthday date." "Name of the property for contact birthday date."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-note-property "NOTE" (defcustom org-contacts-note-property "NOTE"
"Name of the property for contact note." "Name of the property for contact note."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-alias-property "ALIAS" (defcustom org-contacts-alias-property "ALIAS"
"Name of the property for contact name alias." "Name of the property for contact name alias."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-ignore-property "IGNORE" (defcustom org-contacts-ignore-property "IGNORE"
"Name of the property, which values will be ignored when "Name of the property, which values will be ignored when
completing or exporting to vcard." completing or exporting to vcard."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-birthday-format "Birthday: %l (%Y)" (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
@ -125,48 +118,39 @@ The following replacements are available:
%l - Link to the heading %l - Link to the heading
%y - Number of year %y - Number of year
%Y - Number of year (ordinal)" %Y - Number of year (ordinal)"
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-last-read-mail-property "LAST_READ_MAIL" (defcustom org-contacts-last-read-mail-property "LAST_READ_MAIL"
"Name of the property for contact last read email link storage." "Name of the property for contact last read email link storage."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-icon-property "ICON" (defcustom org-contacts-icon-property "ICON"
"Name of the property for contact icon." "Name of the property for contact icon."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-nickname-property "NICKNAME" (defcustom org-contacts-nickname-property "NICKNAME"
"Name of the property for IRC nickname match." "Name of the property for IRC nickname match."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-icon-size 32 (defcustom org-contacts-icon-size 32
"Size of the contacts icons." "Size of the contacts icons."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-icon-use-gravatar (fboundp 'gravatar-retrieve) (defcustom org-contacts-icon-use-gravatar (fboundp 'gravatar-retrieve)
"Whether use Gravatar to fetch contact icons." "Whether use Gravatar to fetch contact icons."
:type 'boolean :type 'boolean)
:group 'org-contacts)
(defcustom org-contacts-completion-ignore-case t (defcustom org-contacts-completion-ignore-case t
"Ignore case when completing contacts." "Ignore case when completing contacts."
:type 'boolean :type 'boolean)
:group 'org-contacts)
(defcustom org-contacts-group-prefix "+" (defcustom org-contacts-group-prefix "+"
"Group prefix." "Group prefix."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-tags-props-prefix "#" (defcustom org-contacts-tags-props-prefix "#"
"Tags and properties prefix." "Tags and properties prefix."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-matcher (defcustom org-contacts-matcher
(mapconcat #'identity (mapconcat #'identity
@ -179,29 +163,24 @@ The following replacements are available:
"|") "|")
"Matching rule for finding heading that are contacts. "Matching rule for finding heading that are contacts.
This can be a tag name, or a property check." This can be a tag name, or a property check."
:type 'string :type 'string)
:group 'org-contacts)
(defcustom org-contacts-email-link-description-format "%s (%d)" (defcustom org-contacts-email-link-description-format "%s (%d)"
"Format used to store links to email. "Format used to store links to email.
This overrides `org-email-link-description-format' if set." This overrides `org-email-link-description-format' if set."
:group 'org-contacts
:type 'string) :type 'string)
(defcustom org-contacts-vcard-file "contacts.vcf" (defcustom org-contacts-vcard-file "contacts.vcf"
"Default file for vcard export." "Default file for vcard export."
:group 'org-contacts
:type 'file) :type 'file)
(defcustom org-contacts-enable-completion t (defcustom org-contacts-enable-completion t
"Enable or not the completion in `message-mode' with `org-contacts'." "Enable or not the completion in `message-mode' with `org-contacts'."
:group 'org-contacts
:type 'boolean) :type 'boolean)
(defcustom org-contacts-complete-functions (defcustom org-contacts-complete-functions
'(org-contacts-complete-group org-contacts-complete-tags-props org-contacts-complete-name) '(org-contacts-complete-group org-contacts-complete-tags-props org-contacts-complete-name)
"List of functions used to complete contacts in `message-mode'." "List of functions used to complete contacts in `message-mode'."
:group 'org-contacts
:type 'hook) :type 'hook)
;; Decalre external functions and variables ;; Decalre external functions and variables
@ -224,8 +203,8 @@ A regexp matching strings of whitespace, `,' and `;'.")
(defvar org-contacts-keymap (defvar org-contacts-keymap
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map "M" 'org-contacts-view-send-email) (define-key map "M" #'org-contacts-view-send-email)
(define-key map "i" 'org-contacts-view-switch-to-irc-buffer) (define-key map "i" #'org-contacts-view-switch-to-irc-buffer)
map) map)
"The keymap used in `org-contacts' result list.") "The keymap used in `org-contacts' result list.")
@ -463,7 +442,7 @@ prefixes rather than just the beginning of the string."
((and (listp flag) (eq (car flag) 'boundaries)) ((and (listp flag) (eq (car flag) 'boundaries))
(org-contacts-boundaries-prefix string collection predicate (cdr flag))) (org-contacts-boundaries-prefix string collection predicate (cdr flag)))
((eq flag 'metadata) ((eq flag 'metadata)
(org-contacts-metadata-prefix string collection predicate)) (org-contacts-metadata-prefix))
(t nil ; operation unsupported (t nil ; operation unsupported
))))) )))))
@ -496,7 +475,7 @@ prefixes rather than just the beginning of the string."
(defun org-contacts-boundaries-prefix (string collection predicate suffix) (defun org-contacts-boundaries-prefix (string collection predicate suffix)
(cl-list* 'boundaries (completion-boundaries string collection predicate suffix))) (cl-list* 'boundaries (completion-boundaries string collection predicate suffix)))
(defun org-contacts-metadata-prefix (string collection predicate) (defun org-contacts-metadata-prefix (&rest _)
'(metadata . '(metadata .
((cycle-sort-function . org-contacts-display-sort-function) ((cycle-sort-function . org-contacts-display-sort-function)
(display-sort-function . org-contacts-display-sort-function)))) (display-sort-function . org-contacts-display-sort-function))))
@ -524,7 +503,7 @@ A group FOO is composed of contacts with the tag FOO."
;; We've found the correct group, returns the address ;; We've found the correct group, returns the address
(let ((tag (get-text-property 0 'org-contacts-group (let ((tag (get-text-property 0 'org-contacts-group
(car completion-list)))) (car completion-list))))
(mapconcat 'identity (mapconcat #'identity
(cl-loop for contact in (org-contacts-filter (cl-loop for contact in (org-contacts-filter
nil nil
tag) tag)
@ -559,7 +538,7 @@ description."
(when completion-p (when completion-p
(let ((result (let ((result
(mapconcat (mapconcat
'identity #'identity
(cl-loop for contact in (org-contacts-db) (cl-loop for contact in (org-contacts-db)
for contact-name = (car contact) for contact-name = (car contact)
for email = (org-contacts-strip-link for email = (org-contacts-strip-link
@ -567,7 +546,8 @@ description."
(or (or
(cdr (assoc-string org-contacts-email-property (cdr (assoc-string org-contacts-email-property
(cl-caddr contact))) (cl-caddr contact)))
""))) "")) "")))
""))
;; for tags = (cdr (assoc "TAGS" (nth 2 contact))) ;; for tags = (cdr (assoc "TAGS" (nth 2 contact)))
;; for tags-list = (if tags ;; for tags-list = (if tags
;; (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":") ;; (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":")
@ -576,6 +556,10 @@ description."
if (with-current-buffer (marker-buffer marker) if (with-current-buffer (marker-buffer marker)
(save-excursion (save-excursion
(goto-char marker) (goto-char marker)
;; FIXME: AFAIK, `org-make-tags-matcher' returns
;; a cons whose cdr is a function, so why do we
;; pass it to `eval' rather than to (say)
;; `funcall'?
(eval (cdr (org-make-tags-matcher (cl-subseq string 1)))))) (eval (cdr (org-make-tags-matcher (cl-subseq string 1))))))
collect (org-contacts-format-email contact-name email)) collect (org-contacts-format-email contact-name email))
","))) ",")))
@ -683,7 +667,7 @@ Format is a string matching the following format specification:
%y - Number of year %y - Number of year
%Y - Number of year (ordinal)" %Y - Number of year (ordinal)"
(let ((calendar-date-style 'american) (let ((calendar-date-style 'american)
(entry "")) ) ;; (entry "")
(unless format (setq format org-contacts-birthday-format)) (unless format (setq format org-contacts-birthday-format))
(cl-loop for contact in (org-contacts-filter) (cl-loop for contact in (org-contacts-filter)
for anniv = (let ((anniv (cdr (assoc-string for anniv = (let ((anniv (cdr (assoc-string
@ -693,7 +677,9 @@ Format is a string matching the following format specification:
(calendar-gregorian-from-absolute (calendar-gregorian-from-absolute
(org-time-string-to-absolute anniv)))) (org-time-string-to-absolute anniv))))
;; Use `diary-anniversary' to compute anniversary. ;; Use `diary-anniversary' to compute anniversary.
if (and anniv (apply 'diary-anniversary anniv)) ;; FIXME: should we require `diary-lib' somewhere to be sure
;; `diary-anniversary' is defined when we get here?
if (and anniv (apply #'diary-anniversary anniv))
collect (format-spec format collect (format-spec format
`((?l . ,(org-with-point-at (cadr contact) (org-store-link nil))) `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil)))
(?h . ,(car contact)) (?h . ,(car contact))
@ -703,9 +689,9 @@ Format is a string matching the following format specification:
(calendar-extract-year anniv)))) (calendar-extract-year anniv))))
(format "%d%s" years (diary-ordinal-suffix years))))))))) (format "%d%s" years (diary-ordinal-suffix years)))))))))
(defun org-completing-read-date (prompt collection (defun org-completing-read-date ( prompt _collection
&optional predicate require-match initial-input &optional _predicate _require-match _initial-input
hist def inherit-input-method) _hist def _inherit-input-method)
"Like `completing-read' but reads a date. "Like `completing-read' but reads a date.
Only PROMPT and DEF are really used." Only PROMPT and DEF are really used."
(org-read-date nil nil nil prompt nil def)) (org-read-date nil nil nil prompt nil def))
@ -817,9 +803,9 @@ This adds `org-contacts-gnus-check-mail-address' and
`gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'" `gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'"
(require 'gnus) (require 'gnus)
(require 'gnus-art) (require 'gnus-art)
(define-key gnus-summary-mode-map ";" 'org-contacts-gnus-article-from-goto) (define-key gnus-summary-mode-map ";" #'org-contacts-gnus-article-from-goto)
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address) (add-hook 'gnus-article-prepare-hook #'org-contacts-gnus-check-mail-address)
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail)) (add-hook 'gnus-article-prepare-hook #'org-contacts-gnus-store-last-mail))
(defun org-contacts-setup-completion-at-point () (defun org-contacts-setup-completion-at-point ()
"Add `org-contacts-message-complete-function' as a new function "Add `org-contacts-message-complete-function' as a new function
@ -828,11 +814,11 @@ to complete the thing at point."
'org-contacts-message-complete-function)) 'org-contacts-message-complete-function))
(defun org-contacts-unload-hook () (defun org-contacts-unload-hook ()
(remove-hook 'message-mode-hook 'org-contacts-setup-completion-at-point)) (remove-hook 'message-mode-hook #'org-contacts-setup-completion-at-point))
(when (and org-contacts-enable-completion (when (and org-contacts-enable-completion
(boundp 'completion-at-point-functions)) (boundp 'completion-at-point-functions))
(add-hook 'message-mode-hook 'org-contacts-setup-completion-at-point)) (add-hook 'message-mode-hook #'org-contacts-setup-completion-at-point))
(defun org-contacts-wl-get-from-header-content () (defun org-contacts-wl-get-from-header-content ()
"Retrieve the content of the `From' header of an email. "Retrieve the content of the `From' header of an email.
@ -899,24 +885,35 @@ address."
(setq pom (or pom (point))) (setq pom (or pom (point)))
(catch 'icon (catch 'icon
;; Use `org-contacts-icon-property' ;; Use `org-contacts-icon-property'
(let ((image-path (if-let ((avatar (org-entry-get pom org-contacts-icon-property)) (let* ((link-matcher-regexp
(link-matcher-regexp "\\[\\[\\([^]]*\\)\\]\\(\\[\\(.*\\)\\]\\)?\\]")) "\\[\\[\\([^]]*\\)\\]\\(\\[\\(.*\\)\\]\\)?\\]")
(cond (contacts-dir (file-name-directory (car org-contacts-files)))
;; [[file:dir/filename.png]] (image-path
((string-match-p "\\[\\[.*\\]\\]" avatar) (if-let ((avatar (org-entry-get pom org-contacts-icon-property)))
(when (string-match link-matcher-regexp avatar) (cond
(expand-file-name (substring (match-string-no-properties 1 avatar) 5 nil) ;; [[file:dir/filename.png]]
(file-name-directory (first org-contacts-files))))) ((string-match-p "\\[\\[.*\\]\\]" avatar)
;; "" (empty string) ;; FIXME: What if avatar matches the above regexp but the
((string-empty-p avatar) nil) ;; one below?
(t (expand-file-name avatar (file-name-directory (first org-contacts-files)))))))) (when (string-match link-matcher-regexp avatar)
;; FIXME: 5 seems to be the length of `file:' but I can't
;; see anything that guarantees that the submatch 1 starts
;; with `file:'.
(expand-file-name (substring (match-string-no-properties 1 avatar) 5 nil)
contacts-dir)))
;; "" (empty string)
((string-empty-p avatar) nil)
(t (expand-file-name avatar contacts-dir))))))
(when image-path (when image-path
(throw 'icon (throw 'icon
(if (featurep 'imagemagick) (if (featurep 'imagemagick)
(create-image image-path 'imagemagick nil :height org-contacts-icon-size) (create-image image-path 'imagemagick nil
(create-image image-path nil nil :height org-contacts-icon-size))))) :height org-contacts-icon-size)
(create-image image-path nil nil
:height org-contacts-icon-size)))))
;; Next, try Gravatar ;; Next, try Gravatar
(when org-contacts-icon-use-gravatar (when org-contacts-icon-use-gravatar
(defvar gravatar-size)
(let* ((gravatar-size org-contacts-icon-size) (let* ((gravatar-size org-contacts-icon-size)
(email-list (org-entry-get pom org-contacts-email-property)) (email-list (org-entry-get pom org-contacts-email-property))
(gravatar (gravatar
@ -965,7 +962,8 @@ address."
"Return all nicknames of all ERC buffers." "Return all nicknames of all ERC buffers."
(cl-loop for buffer in (erc-buffer-list) (cl-loop for buffer in (erc-buffer-list)
nconc (with-current-buffer buffer nconc (with-current-buffer buffer
(cl-loop for user-entry in (mapcar 'car (erc-get-channel-user-list)) (cl-loop for user-entry
in (mapcar #'car (erc-get-channel-user-list))
collect (elt user-entry 1))))) collect (elt user-entry 1)))))
(add-to-list 'org-property-set-functions-alist (add-to-list 'org-property-set-functions-alist
@ -1161,15 +1159,16 @@ are effectively trimmed). If nil, all zero-length substrings are retained."
;;; Add an Org link type `org-contact:' for easy jump to or searching org-contacts headline. ;;; Add an Org link type `org-contact:' for easy jump to or searching org-contacts headline.
;;; link spec: [[org-contact:query][desc]] ;;; link spec: [[org-contact:query][desc]]
(org-link-set-parameters "org-contact" (org-link-set-parameters "org-contact"
:follow 'org-contacts-link-open :follow #'org-contacts-link-open
:complete 'org-contacts-link-complete :complete #'org-contacts-link-complete
:store 'org-contacts-link-store :store #'org-contacts-link-store
:face 'org-contacts-link-face) :face 'org-contacts-link-face)
(defun org-contacts-link-store () (defun org-contacts-link-store ()
"Store the contact in `org-contacts-files' with a link." "Store the contact in `org-contacts-files' with a link."
(when (and (eq major-mode 'org-mode) (when (and (eq major-mode 'org-mode)
(member (buffer-file-name) (mapcar 'expand-file-name org-contacts-files))) (member (buffer-file-name)
(mapcar #'expand-file-name org-contacts-files)))
(if (bound-and-true-p org-id-link-to-org-use-id) (if (bound-and-true-p org-id-link-to-org-use-id)
(org-id-store-link) (org-id-store-link)
(let ((headline-str (substring-no-properties (org-get-heading t t t t)))) (let ((headline-str (substring-no-properties (org-get-heading t t t t))))
@ -1182,7 +1181,8 @@ are effectively trimmed). If nil, all zero-length substrings are retained."
link))))) link)))))
(defun org-contacts--all-contacts () (defun org-contacts--all-contacts ()
"Return an alist (name . (file . position)) of all contacts in `org-contacts-files'." "Return a list of all contacts in `org-contacts-files'.
Each element has the form (NAME . (FILE . POSITION))."
(car (mapcar (car (mapcar
(lambda (file) (lambda (file)
(unless (buffer-live-p (get-buffer (file-name-nondirectory file))) (unless (buffer-live-p (get-buffer (file-name-nondirectory file)))
@ -1226,7 +1226,7 @@ are effectively trimmed). If nil, all zero-length substrings are retained."
;; (with-current-buffer buf (goto-char position))) ;; (with-current-buffer buf (goto-char position)))
)))) ))))
(defun org-contacts-link-complete (&optional arg) (defun org-contacts-link-complete (&optional _arg)
"Create a org-contacts link using completion." "Create a org-contacts link using completion."
(let ((name (completing-read "org-contact Name: " (let ((name (completing-read "org-contact Name: "
(mapcar (mapcar