;;; org-people.el --- Work with a contact-list in org-mode files -*- lexical-binding: t; -*-

;; Copyright (C) 2026 Steve Kemp

;; Author: Steve Kemp <steve@steve.fi>
;; Maintainer: Steve Kemp <steve@steve.fi>
;; Package-Version: 2.11.1
;; Package-Revision: cc97f09b395f
;; Package-Requires: ((emacs "29.1") (org "9.0"))
;; Keywords: outlines, contacts, people
;; URL: https://github.com/skx/org-people

;; This file is not part of GNU Emacs.

;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this file.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A package to collect contacts from org-agenda files, and allow
;; operations to be carried out on them.
;;
;; By default all tree-items with a "contact" tag, which contain
;; properties, are considered contacts.
;;
;; An example pair of contacts would look like this inside an org-mode
;; file:
;;
;;   * People
;;     ** Alice                        :family:contact:
;;     :PROPERTIES:
;;     :ADDRESS: 32 Something Street
;;     :EMAIL: alice@example.com
;;     :PHONE: +123 456 789
;;     :CHILDREN: Mallory
;;     :NICKNAME: Allu
;;     :END:
;;     ** Bob                           :colleague:contact:
;;     :PROPERTIES:
;;     :ADDRESS: 32 Something Lane
;;     :EMAIL: bob@example.com
;;     :PHONE: +123 456 987
;;     :END:
;;
;; The specific properties used don't matter, although it seems natural
;; to use :ADDRESS, :EMAIL, and :PHONE.  A contact will be discovered
;; if there is at least one property present alongside the mandatory
;; "contact" tag.  (You can change the name of the tag used to search for
;; people by setting `org-people-search-tag' to your preferred alternative.)
;;

;;; Basic operations

;; Once your agenda files have been loaded `org-people-summary' will
;; show a buffer of all known contacts, and from there you can copy
;; attributes, jump to their definitions, & etc.
;;
;; `org-people-insert' allows you to interactively insert data from
;; your contacts with helpful TAB-completion, on both the name of the
;; contact and the attribute name to be inserted.
;;
;; We provide a new link-type `org-people:' which allows you to jump
;; to a contact's definition when followed.   If you have such links
;; within your document (e.g. a link such as [[org-people:Steve Kemp]]
;; you can use the helper `org-people-add-descriptions' to automatically
;; add the contact description automatically - although if you used
;; C-c C-l to insert such a link the description should be auto-populated.
;;

;;; org-table helpers

;; Contacts need the "contacts" tag to be present to be discovered and
;; included in the `org-people' functions, but you can also use the
;; standard `org-mode' facilities to add additional tags to entries too.
;; Using the extra tags you may build simple tables of matching entries.
;; For example the following can auto-update when you select the code-block
;; and run "C-c C-c":
;;
;;    #+NAME: get-family-contacts
;;    #+BEGIN_SRC elisp :results value table
;;    (org-people-tags-to-table "family")
;;    #+END_SRC
;;
;; If you prefer to include different columns in your generated table you
;; can specify those directly:
;;
;;   #+NAME: get-family-contacts
;;   #+BEGIN_SRC elisp :results value table
;;   (org-people-tags-to-table "family" '(:LINK :PHONE))
;;   #+END_SRC
;;
;; You may also create a table including all known data about a single named
;; individual:
;;
;;    #+NAME: steve-kemp
;;    #+BEGIN_SRC elisp :results value table :colnames '("Field" "Value")
;;    (org-people-person-to-table "Steve Kemp")
;;    #+END_SRC
;;
;; In this case properties listed in `org-people-ignored-properties` will
;; be ignored and excluded from the generated table.
;;

;;; summary-view

;; There is the ability to mark/unmark rows within the list of people
;; generated by `org-people-summary'.
;;
;; Using that facility you can write code that operates on either the
;; people who are currently marked, or if none then the person upon
;; the current row.  See `org-people-summary-marked-or-current' for
;; a useful helper to simplify that.
;;
;; A similar helper `org-people-get-property-marked-or-current' allows
;; fetching the values of a given property for each marked contact,
;; or the person upon the current row if nothing is marked.
;;
;; The vCARD and CSV exporter functions use this facility, as does
;; the "open website" and "compose email" functions which are bound
;; by default within the summary-view.
;;
;; Pressing TAB within the summary will allow you to view all defined
;; property for the contact at the point, and pressing again will hide
;; the inline display.
;;

;;; complete-at-point

;; There are a pair of functions provided for the complete-at-point
;; framework - one for names and one for email addresses.  They might
;; be enabled like so:
;;
;;  (add-hook 'message-mode-hook
;;          (lambda ()
;;                  (add-hook 'completion-at-point-functions
;;                      #'org-people-email-capf
;;                      nil t)))
;;
;;  (add-hook 'text-mode-hook
;;          (lambda ()
;;            (add-hook 'completion-at-point-functions
;;                      #'org-people-capf
;;                      nil t)))
;;

;;; hl-line-mode

;; If you want to enable `hl-line-mode` that is supported, and there are local
;; configurations setup so that only people are highlighted - rather than any
;; inline property blocks which might be present.
;;
;; Simply add this to your configuration:
;;
;;   (add-hook 'org-people-summary-mode-hook #'(lambda () (hl-line-mode 1)))
;;

;;; Code:

(require 'cl-lib)
(require 'seq)
(require 'org)


;; Avoid byte-compile warnings for org functions
(declare-function org-map-entries "org" (&rest args))
(declare-function org-get-tags "org" (&optional pom inherit))
(declare-function org-entry-properties "org" (&optional pom scope))
(declare-function org-heading-components "org" (&optional pom))
(declare-function org-complex-heading-regexp-format "org" ())

;;; Configuration:

;;;; input selection

(defvar org-people-search-tag "contact"
  "This is the tag-filter for finding contacts.")

(defvar org-people-search-type 'agenda
  "The filter which is used for finding entries, via `org-map-entries'.

By default this is configured to allow all of your agenda files to
be processed.  You might consider replacing this with a list of
file-paths, in which case only those specific files will be read
for contacts.")

;;;; column and ignored preferences

(defvar org-people-summary-properties
  '((:NAME  :width 30)
    (:EMAIL :width 35)
    (:FLAG  :width 5)     ; 🇬🇧 / 🇫🇮 / etc.
    (:PHONE :width 15)
    (:TAGS  :width 15))
  "List of columns to display in `org-people-summary'.

If a column would be 100% empty, i.e. no contacts have that property
defined, then it will be removed automatically.

You may add faux-properties and define titles and getter-functions
to allow constructing arbitrary columns.")

(defvar org-people-ignored-properties
  (list :CREATED :ID :MARKER)
  "Properties which are generally ignored within people definitions.

These are properties which are specifically excluded when creating
an `org-mode' table from a persons details with the
`org-people-person-to-table' function, and also when completion
is invoked by `org-people-insert'.")

(defvar org-people-ignored-tags
  (list org-people-search-tag "noexport")
  "A list of tags which are removed from contacts.

We require all people to be tagged with something so that we can
find them, as specified by `org-people-search-tag'.  This tag would
be present on all known contacts so we configure it to be removed
here, as well as removing \='noexport\=' by default too.")

;;;; buffer names

(defvar org-people-summary-buffer-name
  "*Contacts*"
  "The name of the buffer to create when `org-people-summary' is invoked.")

(defvar org-people-vcard-buffer-name
  "*VCARD*"
  "This is the name of the buffer which is used for vCARD exports.

In previous releases a buffer was created based upon the name of
single contacts, however now it is possible to mark and export
multiple people in a single operation so the name has to be
person-agnostic, and we specify what to use here.")

;;; CSV export config

(defvar org-people-csv-buffer-name
  "*CSV*"
  "This is the name of the buffer which is used for CSV exports.

CSV exports are written according to the properties listed in
`org-people-csv-export-properties'.  The export will contain a
header if `org-people-csv-header' is set to a non-nil value.")

(defvar org-people-csv-export-properties
  '(:NAME :EMAIL :PHONE)
  "A list of the properties to export to CVS.

The export will contain a header if `org-people-csv-header' is set
to a non-nil value.")

(defvar org-people-csv-header
  t
  "Should a header be included in the CSV export?")


;;;; caching config

(defvar org-people-use-cache t
  "Non-nil means `org-people-parse' caches the result of `org-people--parser'.
If nil, `org-people--parser' is called afresh every time.")

(defvar org-people--cache nil
  "Internal cache of `org-people--parser' results.")

;;;; internal usage only

(defvar org-people-summary--columns)
(defvar org-people-summary--active-columns)

(defvar org-people--expanded-entries (make-hash-table :test 'equal)
  "Track which entries are expanded in this buffer.")

(defvar org-people--max-property-name-width 0
  "Maximum width of property names, precomputed for alignment.")

(defvar org-people-summary-mode-map
  (let ((map (make-sparse-keymap)))
    ;; basic operations
    (define-key map (kbd "RET") #'org-people-summary--open)
    (define-key map (kbd "c") #'org-people-summary--copy-field)
    (define-key map (kbd "s") #'isearch-forward)
    (define-key map (kbd "TAB") #'org-people-toggle-entry)

    ;; (n)ext and (p)revious skip the inline properties
    (define-key map (kbd "n") #'org-people-summary-next)
    (define-key map (kbd "p") #'org-people-summary-prev)

    ;; filtering
    (define-key map (kbd "f") #'org-people-summary--filter-by-property)
    (define-key map (kbd "F") #'org-people-summary--filter-has-property)

    ;; column-handling.
    (define-key map (kbd "t") #'org-people-summary--toggle-column)
    (define-key map (kbd "T") #'org-people-summary--hide-this-column)
    (define-key map (kbd "r") #'org-people-summary-show-all-columns)
    (define-key map (kbd "R") #'org-people-summary-force-refresh)

    ;; setting and clearing marks.
    (define-key map (kbd "m") #'org-people-summary--mark-row)
    (define-key map (kbd "M") #'org-people-summary--mark-all)
    (define-key map (kbd "u") #'org-people-summary--unmark-row)
    (define-key map (kbd "U") #'org-people-summary--unmark-all)

    ;; Operating on marked rows, or the current row if nothing marked.
    (define-key map (kbd "v") #'org-people-summary--vcard) ;; depreciated
    (define-key map (kbd "V") #'org-people-summary--vcard)
    (define-key map (kbd "C") #'org-people-summary--csv)
    (define-key map (kbd "w") #'org-people-summary--open-website)
    (define-key map (kbd "e") #'org-people-summary--compose-mail)
    map)
  "Keymap for `org-people-summary-mode'.")




;;
;; Core
;;

(defun org-people-parse ()
  "Return all known people as a hash-table of NAME: PLIST from agenda files.

If `org-people-use-cache' is non-nil return cached results when present,
otherwise parse the agenda-files every time via `org-people--parser'.

The cache may be invalidated explicitly via a call to `org-people-clear-cache'.

All :MARKER properties pointing to dead buffers are removed automatically."
  (let ((db (if org-people-use-cache
                (or org-people--cache
                    (setq org-people--cache (org-people--parser)))
              ;; cache disabled, parse directly
              (org-people--parser))))
    ;; If we have markers point to buffers that don't exist then
    ;; flush the cache.  This is overkill, but better to err on the
    ;; side of caution.
    (maphash (lambda (_name plist)
               (org-people--sanitize-cache plist))
             db)
    db))


(defun org-people--parser ()
  "Return hash table of NAME -> PLIST from all agenda-files.

We only include data from headlines which have a tag matching
`org-people-search-tag', and at least one property.

The `org-mode' caching and parsing layer is good, but this
function is intended to be wrapped by our own caching layer.

This is an internal function which parses agenda-files every
time it is invoked.  `org-people-parse' is the user-visible
entry to our contacts - that adds on an (optional) caching
layer which makes re-requesting details cheaper."
  (with-delayed-message (2 (format "Parsing contacts"))
    (let ((table (make-hash-table :test #'equal)))
      (org-map-entries
       (lambda ()
         (let* ((name (nth 4 (org-heading-components)))
               (plist nil)
               (entry-tags (org-get-tags))
               ; remove "contacts" from the tag-list
               (filtered-tags
                (seq-remove (lambda (tag)
                              (member tag org-people-ignored-tags))
                            entry-tags)))
           ;; Get any associated properties
           (dolist (prop (org-entry-properties nil 'standard))
             (let ((key (intern (concat ":" (car prop))))
                   (val (cdr prop)))
               (setq plist (plist-put plist key val))))
           ;; Save the details if we have more than one property present.
           (when (and plist (> (/ (length plist) 2) 1))
             ;; some generated properties.
             (setq plist (plist-put plist :NAME name))
             (setq plist (plist-put plist :MARKER (point-marker)))
             (if (not (null filtered-tags))
                 (setq plist (plist-put plist :TAGS filtered-tags)))
             (puthash name plist table))
           table))
       (concat "+" org-people-search-tag)
       org-people-search-type)
      table)))

(defun org-people-clear-cache (&rest _)
  "Clear the org-people cache."
  (setq org-people--cache nil))

(defun org-people--sanitize-cache (plist)
  "Flush the `org-people-parse' buffer if the buffer is dead.

If we have a marker which points to a buffer which no longer
exists then invalidate the cache.

Argument PLIST is the plist to examine for markers."
  (let ((m (plist-get plist :MARKER)))
    (when (and m (not (marker-buffer m)))
      (org-people-clear-cache))))

(defun org-people-remove-dead-markers (buffer)
  "If a :MARKER-target buffer is killed, then flush the cache.

The BUFFER specifies the buffer whcih is being killed, and should
be examined for :MARKER targets."
  (when (and org-people--cache org-people-use-cache)
    (maphash
     (lambda (_name plist)
       (when (and (plist-get plist :MARKER)
                  (eq (marker-buffer (plist-get plist :MARKER)) buffer))
         (org-people-clear-cache)))
     org-people--cache)))


;;;###autoload
(defun org-people-insert ()
  "Insert a specific piece of data from a contact.

This uses `org-people-select-interactively' to first prompt the user
for a contact, and then a second interactive selection of the specific
attribute value which should be inserted.

Properties which are included in `org-people-ignored-properties' are
excluded from the completion."
  (interactive)
  (let* ((person (org-people-select-interactively))
         (values (org-people-get-by-name person))
         (ignored org-people-ignored-properties)
         (completion-ignore-case t)
         (completion-styles '(basic substring partial-completion)))
    (if values
        ;; Collect keys and remove ignored ones
        (let* ((keys (cl-loop for (k ) on values by #'cddr
                              unless (memq k ignored)
                              collect k))
               ;; prompt
               (choice (intern (completing-read
                                "Attribute: "
                                (mapcar #'symbol-name keys)
                                nil t))))
          ;; insert
          (insert (or (plist-get values choice) "")))
      (if person
          (user-error "No properties present for contact %s" person)
        (user-error "No contact selected")))))



;;
;; Filtering and searching functions that build upon the data-structure
;; which org-people-parse returns.
;;

(defun org-people-names ()
  "Return all known contact names.

This uses `org-people-parse' to get the list of parsed/discovered contacts."
  (sort (hash-table-keys (org-people-parse)) #'string<))

(defun org-people--properties (table)
  "Return a sorted list of all distinct plist keys used in TABLE."
  (let (keys)
    (maphash
     (lambda (_name plist)
       (while plist
         (let ((key (car plist)))
           (unless (memq key org-people-ignored-properties)
             (push key keys)))
         (setq plist (cddr plist))))
     table)
    (sort (delete-dups keys)
          (lambda (a b)
            (string< (symbol-name a)
                     (symbol-name b))))))

(defun org-people--alias-table ()
  "Return a hash of completion-string -> canonical-name.

This is used to allow TAB-completion against :NICKNAME properties
which might be associated with contacts."
  (let ((alias-table (make-hash-table :test #'equal))
        (people (org-people-parse)))
    (maphash
     (lambda (name plist)
       ;; Always allow completion on canonical name
       (puthash name name alias-table)

       ;; Support single nickname
       (when-let ((nick (plist-get plist :NICKNAME)))
         (puthash nick name alias-table))

       ;; Optional: support multiple aliases separated by ;
       (when-let ((aliases (plist-get plist :ALIASES)))
         (dolist (alias (split-string aliases ";" t "[[:space:]]*"))
           (puthash alias name alias-table))))
     people)
    alias-table))





;;
;; Completion-related code
;;

(defun org-people--completion-annotation (name)
  "Return a annotation-string for the specific candidate.

NAME is the name of the contact."
  (let* ((plist (org-people-get-by-name name))
         (email (plist-get plist :EMAIL))
         (phone (plist-get plist :PHONE))
         (alias-table (org-people--alias-table))
         (canonical (gethash name alias-table)))
    (string-join
     (delq nil
           (list (when email (format " [%s]" email))
                 (when phone (format " ☎ %s" phone))
                 (when (not (string= name canonical))
                   (format " (%s)" canonical))))
     "  ")))

(defun org-people--completion-table (string pred action)
  "Return a completion-table for contact completion.

STRING PRED and ACTION are passed to `complete-with-action', and
not used directly."
  (let* ((alias-table (org-people--alias-table))
         (candidates (hash-table-keys alias-table)))
    (if (eq action 'metadata)
        '(metadata
          (annotation-function . org-people--completion-annotation)
          (category . org-people))
      (complete-with-action action candidates string pred))))

(defun org-people-select-interactively ()
  "Select a contact by name or nickname."
  (let* ((alias-table (org-people--alias-table))
         (completion-ignore-case t)
         (completion-styles '(basic substring partial-completion))
         (completion
          (completing-read
           "Contact name: "
           (lambda (string pred action)
             (org-people--completion-table string pred action))
           nil t)))
    ;; Return canonical name
    (gethash completion alias-table)))


(defun org-people-email-candidates ()
  "Provide candidates for completion via capf."
  (let (cands)
    (maphash
     (lambda (name plist)
       (let ((email (plist-get plist :EMAIL)))
         (when email
           (push (format "%s <%s>" name email) cands))))
     (org-people-parse))
    cands))

(defun org-people--bounds ()
  "Provide bounding-area for candidates for completion via capf.

We do this because otherwise completing against names might fail
if the point were at the start of a surname - as the forename
would not match a symbol, instead showing up as the previous
word."
  (save-excursion
    (let ((end (point)))
      (skip-chars-backward "[:alnum:] ._-")
      (cons (point) end))))

(defun org-people-capf ()
  "Completion-at-point for org-people contacts."
  (let ((bounds (org-people--bounds)))
    (when bounds
      (list
       (car bounds)
       (cdr bounds)
       (org-people-names)
       :annotation-function #'org-people--completion-annotation
       :company-kind (lambda (_) 'user)))))

(defun org-people-email-capf ()
  "Completion-at-point for org-people email addresses."
  (let ((bounds (org-people--bounds)))
    (when bounds
      (list
       (car bounds)
       (cdr bounds)
       (org-people-email-candidates)))))

;;
;; Selection code
;;

(defun org-people-get-by-name (name)
  "Return plist for NAME from known people.

This method is used throughout the code as a means of getting all
of the properties associated with a specific individual."
  (gethash name (org-people-parse)))

(defun org-people-get-by-property (property value &optional regexp)
  "Return contacts by searching the contents of a specific field.

PROPERTY is the name of the property associated with entries, and
VALUE is the string to match with.

By default `string-equality' is used for matching, however if REGEXP
is true then `string-match' is used instead."
 (org-people-filter
   (lambda (plist)
     (let ((found (plist-get plist property)))
       (if regexp
           (and found (string-match-p value found))
         (equal value found))))))

(defun org-people-filter (pred-p)
  "Filter all known contacts by the given predicate.

PRED-P should be a function which accepts the plist of properties associated
with a given contact, and returns t if they should be kept.

See `org-people-get-by-property' for an example use of this function."
 (let (results)
    (maphash
     (lambda (key plist)
       (when (funcall pred-p plist)
         (push (cons key plist) results)))
     (org-people-parse))
    (mapcar #'cdr
            (sort results
                  (lambda (a b)
                    (string< (car a) (car b)))))))




;;
;; Generate org-mode tables
;;

(defun org-people-person-to-table (name)
  "Return table-data about a named contact.

This function is designed to create an `org-mode' table, like so:

#+NAME: myself
#+BEGIN_SRC elisp :results value table :colnames \='(\"Field\" \"Value\")
\(org-people-person-to-table \"Steve Kemp\")
#+END_SRC

Properties listed in `org-people-ignored-properties' are excluded from
the generated table."
  (let* ((plist (org-people-get-by-name name))
         ;; Convert plist to list of (key . value) pairs
         (pairs (seq-partition plist 2))

         ;; Remove ignored keys - :MARKER, etc.
         (filtered (seq-remove (lambda (pair)
                                 (memq (car pair) org-people-ignored-properties))
                               pairs))

         ;; Sort pairs alphabetically by key name (without leading :)
         (sorted
          (sort filtered
                (lambda (a b)
                  (string<
                   (substring (symbol-name (car a)) 1)
                   (substring (symbol-name (car b)) 1)))))
         ;; Convert to rows
         (rows
          (cl-remove-if (lambda (s) (null s))
          (mapcar
           (lambda (pair)
             (if (cadr pair)
             (list
              (capitalize
               (substring (symbol-name (car pair)) 1))
              (cadr pair))))
           sorted))))
    rows))

(defun org-people-tags-to-table (tag &optional props)
  "Return a list of contacts filtered by TAG.

This function is designed to create an `org-mode' table, like so:

#+NAME: family-contacts
#+BEGIN_SRC elisp :results value table
\(org-people-tags-to-table \"family\" \='(:NAME :PHONE))
#+END_SRC

PROPS is a list of property symbols to include, is nil we
default to (:NAME :PHONE :EMAIL).

The special value :LINK: will expand to a clickable link,
using the org-people: handler."
  (let ((people (org-people-parse))
        (props (or props '(:LINK :PHONE :EMAIL)))
        (result))
    (push props result) ; header
    (maphash
     (lambda (name plist)
       (let ((tags (or (plist-get plist :TAGS) '())))
         (when (member tag tags)
           (push
            (mapcar
             (lambda (prop)
               (if (eq prop :NAME)
                   name
                 (if (eq prop :LINK)
                     (org-link-make-string (concat  "[[org-people:" name "][" name "]]"))
                   (or (plist-get plist prop) ""))))
             props)
            result))))
     people)
    (nreverse result)))





;;
;; summary-buffer code, and associated helpers
;;


(cl-defstruct org-people-column
  prop        ;; :NAME, :EMAIL, etc
  width       ;; integer
  title       ;; string, auto-generated
  getter      ;; function (plist -> string)
  visible)    ;; t/nil


;; Build a full column struct from the legacy specification
(defun org-people-summary--make-column (spec)
  "Create a full `org-people-column' entry from SPEC.

SPEC can be:
- a symbol, e.g. :EMAIL
- a list starting with a symbol, followed by WIDTH and any
  optional keyword overrides.

Example: (:NAME 30 :title \"Full Name\" :visible nil)"
  (let* ((prop (if (listp spec) (car spec) spec))
         (plist (if (listp spec) (cdr spec) nil))
         ;; width override: first number in list or :width
         (width (or (cl-find-if #'numberp plist)
                    (plist-get plist :width)
                    20))
         ;; visibility
         (visible (if (plist-member plist :visible)
                      (plist-get plist :visible)
                    t))
         ;; title override or auto-generated
         (title (or (plist-get plist :title)
                    (capitalize (substring (symbol-name prop) 1))))
         ;; getter override or default
         (getter (or (plist-get plist :getter)
                     (cond
                      ((eq prop :TAGS)
                       (lambda (plist)
                         (mapconcat #'identity (or (plist-get plist :TAGS) '()) ",")))
                      (t
                       (lambda (plist)
                         (or (plist-get plist prop) "")))))))
    ;; make the column struct
    (make-org-people-column
     :prop prop
     :width width
     :title title
     :getter getter
     :visible visible)))


;;; Toggle details in summary

(defun org-people-toggle-entry ()
  "Toggle expansion of the contact at point in `org-people-summary-mode'.

Expanded entries show all properties, one per line, with colons neatly aligned.
Properties in `org-people-ignored-properties` are skipped."
  (interactive)
  ;; skip backward if we're inside the inline property list
  (org-people-summary-move-to-contact)

  (let* ((id (tabulated-list-get-id))
         (start (line-end-position)))
    (when id
      (save-excursion
        (let ((inhibit-read-only t))
          (goto-char start)
          (forward-line 1)
          (if (gethash id org-people--expanded-entries)
              ;; Collapse
              (let ((beg (point)))
                (while (looking-at "^    ")
                  (forward-line 1))
                (delete-region beg (point))
                (remhash id org-people--expanded-entries))
            ;; Expand
            (let* ((person (org-people-get-by-name id))
                   (props
                    (cl-loop for (k v) on person by #'cddr
                             unless (or (null v) (memq k org-people-ignored-properties))
                             collect (cons k v))))
              (when props
                ;; sorting properties is neater
                (setq props
                      (sort props
                            (lambda (a b)
                              (string< (symbol-name (car a))
                                       (symbol-name (car b))))))

                ;; Insert the name:value pairs.
                (dolist (pair props)
                  (let* ((name (substring (symbol-name (car pair)) 1))
                         (val (cdr pair))
                         (val-str (if (listp val)
                                      (string-join val ", ")
                                    (format "%s" val)))
                         (name-padded
                          (string-pad
                           name
                           org-people--max-property-name-width nil ? )))
                    (insert (format "    %s : %s\n" name-padded val-str))))
                (puthash id t org-people--expanded-entries)))))))))


(defun org-people-summary-move-to-contact ()
  "Move point to the nearest previous line that does not start with four spaces.

This is designed to allow the user to move to an actual contact, skipping over
any inline property display."
  (interactive)
  (while (and (not (bobp))
              (save-excursion
                (beginning-of-line)
                (looking-at "    ")))
    (forward-line -1))
  (beginning-of-line))

;; ------------------------------------------------------------
;; Helper functions
;; ------------------------------------------------------------

(defun org-people-summary--entry (plist)
  "Build tabulated-list entry for PLIST."
  (let ((columns org-people-summary--active-columns)
        (id (or (plist-get plist :NAME) "")))
    (list id
          (vconcat
           (mapcar (lambda (col)
                     (funcall (org-people-column-getter col) plist))
                   columns)))))

(defun org-people-summary--refresh ()
  "Populate `tabulated-list-entries' and rebuild the table header.

Handles:
- Dynamic removal of empty columns
- First-column overrides for title and getter
- Custom titles, getters, widths, visibility
- Keeps `tabulated-list-format' in sync"
  (let* ((plists (org-people--all-plists))
         ;; Only include visible columns that have at least one non-empty value
         (columns (cl-remove-if-not
                   (lambda (col)
                     (and (org-people-column-visible col)
                          (cl-some (lambda (plist)
                                     (let ((val (funcall (org-people-column-getter col) plist)))
                                       (and val (not (string-empty-p val)))))
                                   plists)))
                   org-people-summary--columns))
         (first-col (car columns)))
    (setq-local org-people-summary--active-columns columns)
    ;; Build tabulated-list-format using :title and :width from the structs
    (setq tabulated-list-format
          (vconcat
           (mapcar (lambda (col)
                     (list (org-people-column-title col)
                           (org-people-column-width col)
                           t))
                   columns)))
    ;; reset state of toggled properties
    (setq org-people--expanded-entries (make-hash-table :test 'equal))
    ;; Sort key reset to avoid stale-column errors
    (setq tabulated-list-sort-key nil)
    ;; Build entries
    (setq tabulated-list-entries
          (mapcar (lambda (plist)
                    (let ((id (funcall (org-people-column-getter first-col) plist)))
                      (list id
                            ;; all columns including first
                            (vconcat
                             (mapcar (lambda (col)
                                       (funcall (org-people-column-getter col) plist))
                                     columns)))))
                  plists))
    ;; Initialize header
    (tabulated-list-init-header)

    ;; Compute max-width once at load time if not done yet
    (setq org-people--max-property-name-width
          (apply #'max
                 (mapcar (lambda (p)
                           (length (substring (symbol-name p) 1)))
                         (org-people--properties (org-people-parse)))))))

(defun org-people-summary--toggle-column ()
  "Interactively toggle visibility of a column."
  (interactive)
  (let* ((columns org-people-summary--columns)
         (names (mapcar #'org-people-column-title columns))
         (choice (completing-read "Toggle column: " names nil t))
         (col (seq-find (lambda (c) (string= (org-people-column-title c) choice))
                        columns)))
    (when col
      (setf (org-people-column-visible col) (not (org-people-column-visible col)))
      (org-people-summary--refresh)
      (tabulated-list-print t))))

(defun org-people-summary--column-at-point ()
  "Return the index of column at point."
  (let ((pos (current-column))
        (i 0)
        (offset 0)
        (cols (append tabulated-list-format nil)))
    (catch 'done
      (dolist (col cols)
        (let ((width (nth 1 col)))
          (when (<= pos (+ offset width))
            (throw 'done i))
          (setq offset (+ offset width tabulated-list-padding))
          (setq i (1+ i))))
      nil)))

(defun org-people-summary--hide-this-column ()
  "Toggle the visibility of the column under the point.

In practice this means hide the column, after all if a column
isn't visible then it cannot be shown so the point cannot be
over it."
  (interactive)
  (let* ((idx (org-people-summary--column-at-point))
         (col (nth idx org-people-summary--active-columns)))
    (unless col
      (user-error "No column at point"))
    (setf (org-people-column-visible col) nil)
    (org-people-summary--refresh)
    (tabulated-list-print t)
    (message "Column '%s' hidden" (org-people-column-title col))))

(defun org-people-summary-show-all-columns ()
  "Show all columns.

This reinstates any columns which might have had their visibility
toggled interactively.  It will not restore columns which are empty."
  (interactive)
  (dolist (col org-people-summary--columns)
    (setf (org-people-column-visible col) t))
  (org-people-summary--refresh)
  (tabulated-list-print t))

(defun org-people-summary-force-refresh ()
  "Force a reload of all agenda files, and flush the cache.

This removes the cache, triggers an org-reload via `org-agenda-redo-all'
and reloads the display."
  (interactive)
  (org-people-clear-cache)
  (kill-buffer (get-buffer-create org-people-summary-buffer-name))
  (org-people-summary))

(defun org-people--csv-escape (value)
  "Escape VALUE for CSV output."
  (let* ((str (format "%s" (or value "")))
         (escaped (replace-regexp-in-string "\"" "\"\"" str)))
    (format "\"%s\"" escaped)))

(defun org-people-export-to-csv (&optional name)
  "Export the given contact to a CSV format.

This function will get, or create, the buffer named in the
`org-people-csv-buffer-name' variable.

NAME should be the name of the contact to export, and the
fields to be exported are specified by `org-people-csv-export-properties'."
  (interactive)
  (if (not name)
      (setq name (org-people-select-interactively)))
  (unless name
      (user-error "No contact selected!"))
  (let* ((plist (org-people-get-by-name name)))
    (with-current-buffer (get-buffer-create org-people-csv-buffer-name)
      (insert
       (mapconcat
        (lambda (p)
          (org-people--csv-escape (plist-get plist p)))
        org-people-csv-export-properties
        ", ")
       "\n")))
  (if (called-interactively-p 'any)
      (pop-to-buffer (get-buffer-create org-people-csv-buffer-name))))

(defun org-people-export-to-vcard (&optional name)
  "Export the given contact to a vCard 3.0 format.

This function will get, or create, the buffer named in the
`org-people-vcard-buffer-name' variable.

NAME should be the name of the contact to export."
  (interactive)
  (if (not name)
      (setq name (org-people-select-interactively)))
  (unless name
      (user-error "No contact selected!"))
  (let* ((plist   (org-people-get-by-name name))
         (name    (plist-get plist :NAME))
         (email   (plist-get plist :EMAIL))
         (phone   (plist-get plist :PHONE))
         (address (plist-get plist :ADDRESS)))

    (with-current-buffer (get-buffer-create org-people-vcard-buffer-name)

      (insert "BEGIN:VCARD\n")
      (insert "VERSION:3.0\n")

      ;; Full name
      (when name
        (insert (format "FN:%s\n" name))
        ;; Structured name (basic split: last word = surname)
        (let* ((parts (split-string name " "))
               (first (string-join (butlast parts) " "))
               (last  (car (last parts))))
          (insert (format "N:%s;%s;;;\n" (or last "") (or first "")))))

      ;; Email
      (when email
        (insert (format "EMAIL;TYPE=INTERNET:%s\n" email)))

      ;; Phone
      (when phone
        (insert (format "TEL;TYPE=CELL:%s\n" phone)))

      ;; Single-line address
      ;; vCard ADR format is:
      ;; ADR;TYPE=HOME:POBOX;EXT;STREET;CITY;REGION;POSTCODE;COUNTRY
      ;; We'll put everything into STREET only.
      (when address
        (insert (format "ADR;TYPE=HOME:;;%s;;;;\n" address)))

      (insert "END:VCARD\n")
      (goto-char (point-min))

      ;; Enable vcard-mode if available
      (when (fboundp 'vcard-mode)
        (vcard-mode))))
    (if (called-interactively-p 'any)
      (pop-to-buffer (get-buffer-create org-people-vcard-buffer-name))))

(defun org-people--open-properties ()
  "Open the property drawer beneath current headline."
  (save-excursion
    (org-back-to-heading t)
    (outline-show-subtree)
    (when (re-search-forward org-property-drawer-re
                             (save-excursion (org-end-of-subtree t t))
                             t)
      (org-fold-region (match-beginning 0)
                       (match-end 0)
                       nil))))

(defun org-people--all-plists ()
  "Return a list of all contact plists."
  (sort (hash-table-values (org-people-parse))
        (lambda (a b)
          (string< (or (plist-get a :NAME) "")
                   (or (plist-get b :NAME) "")))))

(defun org-people-summary--hl-line-range ()
  "Return the range of the line to highlight.
If current line starts with 4 spaces, highlight previous non-indented line."
  (save-excursion
    (beginning-of-line)
    (if (looking-at "^    ")
        ;; Walk backwards to find a non-indented line
        (while (and (not (bobp))
                    (progn
                      (forward-line -1)
                      (beginning-of-line)
                      (looking-at "^    "))))
      ;; else stay on current line
      )
    ;; Return bounds of chosen line
    (cons (line-beginning-position)
          (line-end-position))))

(define-derived-mode org-people-summary-mode tabulated-list-mode "Org-People"
  "Major mode for listing Org People contacts."
  (setq-local show-trailing-whitespace nil)
  (setq tabulated-list-padding 2)
  (setq tabulated-list-sort-key '("Name" . nil))
  (org-people-summary--refresh)
  (setq-local hl-line-range-function #'org-people-summary--hl-line-range)
  (tabulated-list-init-header)
  (tabulated-list-print))



;;
;; summary-buffer functions bound to keys
;;


(defun org-people-summary--open ()
  "Open the Org entry for the contact at point."
  (interactive)
  ;; skip backward if we're inside the inline property list
  (org-people-summary-move-to-contact)
  (let* ((name (tabulated-list-get-id))
         (plist (org-people-get-by-name name)))
    (unless plist
      (user-error "No contact found: %s" name))
    (org-people-browse-name name)))

(defun org-people-summary--mark-all ()
  "Mark all rows in the visible list."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (not (eobp))
      (when (tabulated-list-get-id)
        (tabulated-list-put-tag "*" t)))))

(defun org-people-summary--mark-row ()
  "Add a mark to the current row."
  (interactive)
  (tabulated-list-put-tag "*" t))

(defun org-people-summary--unmark-row ()
  "Remove the mark from the current row."
  (interactive)
  (tabulated-list-put-tag " " t))

(defun org-people-summary--unmark-all ()
  "Remove any mark listed again rows."
  (interactive)
  (tabulated-list-clear-all-tags))


(defun org-people-summary-marked-or-current (function)
  "Call a function for all marked rows, or the current one if nothing marked.

FUNCTION should accept a single argument, the name of the contact to perform
its operation against.  See `org-people-summary--vcard' for an example of
how this might be used."
  (interactive)
  (let ((count 0))
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
        (when (equal (char-after) ?*)
          (setq count (+ count 1))
          (funcall function (tabulated-list-get-id)))
        (forward-line 1)))
    (if (zerop count)
        (progn
          ;; skip backward if we're inside the inline property list
          (org-people-summary-move-to-contact)
          (funcall function (tabulated-list-get-id))))
    count))

(defun org-people-get-property-marked-or-current (property)
  "Return the value of the given property.

Return the value of the given PROPERTY from all marked people,
if no people are marked operate upon the person on the current
row."
  (let ((values nil))
    (org-people-summary-marked-or-current
     (lambda (person)
       (let ((website (plist-get (org-people-get-by-name person) property)))
         (if website
             (add-to-list 'values website)))))
    values))

(defun org-people-summary--open-website ()
  "Open the website for the given person, or marked people."
  (interactive)
  (let ((urls (org-people-get-property-marked-or-current :WEBSITE)))
    (if urls
        (mapcar #'browse-url urls)
      (user-error "No :WEBSITE property found"))))

(defun org-people-summary--compose-mail ()
  "Compose email to the given person, or marked people."
  (interactive)
  (let ((vals (org-people-get-property-marked-or-current :EMAIL)))
    (if vals
        (mapcar #'compose-mail vals)
      (user-error "No :EMAIL property found"))))

(defun org-people-summary--vcard ()
  "Create a VCARD export for the current, or marked, people.

If there are any marks set in the current `org-people-summary'
list then each of them will be exported, otherwise only the
contact at the current row will be processed.

`org-people-vcard-buffer-name' is used to specify the name of
the buffer which should receive the results."
  (interactive)

  ;; kill any old buffer
  (with-current-buffer (get-buffer-create org-people-vcard-buffer-name)
    (erase-buffer))

  ;; export the people
  (org-people-summary-marked-or-current
   (lambda (name)
     (org-people-export-to-vcard name)))

  ;; show the result
  (pop-to-buffer (get-buffer-create org-people-vcard-buffer-name)))

(defun org-people-summary--csv ()
  "Create a CSV export for the current, or marked, people.

If there are any marks set in the current `org-people-summary'
list then each of them will be exported, otherwise only the
contact at the current row will be processed.

`org-people-csv-buffer-name' is used to specify the name of
the buffer which should receive the results, and the format
of the entries is specified by `org-people-csv-export-properties'."
  (interactive)

  ;; kill any old buffer
  (with-current-buffer (get-buffer-create org-people-csv-buffer-name)
    (erase-buffer)

    ;; Insert the header into the buffer
    (if org-people-csv-header
        (insert
         (mapconcat
          (lambda (p)
            (capitalize
             (replace-regexp-in-string "_" " "
                                       (substring (symbol-name p) 1))))
          org-people-csv-export-properties
          ", ")
         "\n")))

  ;; export the people
  (org-people-summary-marked-or-current
   (lambda (name)
     (org-people-export-to-csv name)))

  ;; show the result
  (pop-to-buffer (get-buffer-create org-people-csv-buffer-name)))

(defun org-people-summary--copy-field ()
  "Copy the value of the field under point to the clipboard."
  (interactive)
  (let* ((entry (tabulated-list-get-entry))
         (col   (org-people-summary--column-at-point)))
    (if (and entry col)
        (let ((value (aref entry col)))  ;; entry is always a vector
          (kill-new value)
          (message "Copied: %s" value))
      (message "Could not determine field under point"))))

(defun org-people-summary-next ()
  "Move the point to the beginnng of the line containing the next person.

This skips over any inline properties, if any are visible."
  (interactive)
  (beginning-of-line)
  (forward-line 1)
  (while (looking-at "    ")
    (forward-line 1)))

(defun org-people-summary-prev ()
  "Move the point to the beginnng of the line containing the previous person.

This skips over any inline properties, if any are visible."
  (interactive)
  (beginning-of-line)
  (forward-line -1)
  (while (looking-at "    ")
    (forward-line -1)))

(defun org-people-summary--filter-by-property ()
  "Filter contacts interactively by a property value."
  (interactive)
  (let* ((completion-ignore-case t)
         (completion-styles '(basic substring partial-completion))
         (prop-str (completing-read
                    "Property to filter against: "
                    (org-people--properties (org-people-parse))
                    nil t)))

    (when (string-empty-p prop-str)
      (user-error "No property provided!"))

    (let* ((prop (intern prop-str))
           (value (read-string (format "Value to match for %s: " prop-str))))

      (when (string-empty-p value)
        (user-error "No value provided"))
      ;; Filter list
      (let ((filtered
             (org-people-filter
              (lambda (plist)
                (let ((v (plist-get plist prop)))
                  (cond
                   ((listp v)
                    (seq-some (lambda (item)
                                (and (stringp item)
                                     (string-match-p value item)))
                              v))
                   ((stringp v)
                    (string-match-p value v))
                   (t nil)))))))

        ;; Refresh buffer
        (with-current-buffer org-people-summary-buffer-name
          (let ((inhibit-read-only t))
            (erase-buffer)
            (setq org-people--expanded-entries (make-hash-table :test 'equal))
            (setq tabulated-list-entries
                  (mapcar #'org-people-summary--entry filtered))
            (tabulated-list-print t)))))))


(defun org-people-summary--filter-has-property ()
  "Filter contacts interactively by the presence of a named property.

This allows you to find all contacts with :EMAIL, for example."
  (interactive)
  (let* ((completion-ignore-case t)
         (completion-styles '(basic substring partial-completion))
         (prop-str (completing-read
                    "Property to test for existence: "
                    (org-people--properties (org-people-parse))
                    nil t))
         (prop (intern prop-str)))

    (when (string-empty-p prop-str)
      (user-error "No property provided!"))

    ;; Filter list
    (let ((filtered
           (org-people-filter
            (lambda (plist)
              (let ((v (plist-get plist prop)))
                (if v
                    t
                  nil))))))
      ;; Refresh buffer
      (with-current-buffer org-people-summary-buffer-name
        (let ((inhibit-read-only t))
          (erase-buffer)
          (setq org-people--expanded-entries (make-hash-table :test 'equal))
          (setq tabulated-list-entries
                (mapcar #'org-people-summary--entry filtered))
          (tabulated-list-print t))))))


;;;###autoload
(defun org-people-summary ()
  "Display contacts using `tabulated-list-mode'.

This allows sorting by each column, etc.

Filtering can be applied (using a regexp), and fields copied."
  (interactive)
  ;; Generate full column structs - always up to date
  (setq org-people-summary--columns
        (mapcar #'org-people-summary--make-column
                org-people-summary-properties))

  (let ((buf (get-buffer-create org-people-summary-buffer-name)))
    (with-current-buffer buf
      (org-people-summary-mode)
      (org-people-summary--refresh)
      (tabulated-list-print t))
    (pop-to-buffer buf)))





;;
;; Define a handler for a link of the form "org-person:XXX"
;;

(defun org-people--export-person-link (path desc backend)
  "Export a person link for BACKEND.
PATH is the person name, DESC is the description.

For HTML-exports a link will be made to the contact's website
if a :WEBSITE property is defined, otherwise we just return
the name."
  (let ((name (or desc path)))
    (cond
     ((eq backend 'html)
      (let ((website (plist-get (org-people-get-by-name path) :WEBSITE)))
        (if website
            (format "<a href=\"%s\">%s</a>" website name)
          name)))
     (t
      name))))

(defun org-people-browse-name (&optional name)
  "Open the Org entry for NAME.

If NAME is not set then prompt for it interactively.

This is used by our [[people:xxx]] handler, as well
as the `org-people-summary' mode."
  (interactive)
  (if (not name)
      (setq name (org-people-select-interactively)))
  (unless name
      (user-error "No contact selected!"))
  (let ((marker (plist-get (org-people-get-by-name name) :MARKER)))
    (switch-to-buffer (marker-buffer marker))
    (goto-char marker)
    (org-reveal)
    (org-people--open-properties)
    (recenter)))


(defun org-people-describe-link (link default)
  "Generate a default description for an org-people link.

The DEFAULT value is used, if specified, otherwise we remove
the `org-people' prefix from the LINK and use that."
  (or default
      (string-remove-prefix "org-people:" link)))

(defun org-people-link-completion ()
  "Return completion candidates for org-people links."
  (let ((name (org-people-select-interactively)))
    ;; Return the full path as Org expects
    (concat "org-people:" name)))


(org-link-set-parameters
 "org-people"
 :complete           #'org-people-link-completion
 :insert-description #'org-people-describe-link
 :export             #'org-people--export-person-link
 :follow             #'org-people-browse-name
 :help-echo "Open the contacts-file at the position of the named person, via org-people")




;;
;; Utility functions for users
;;

;;;###autoload
(defun org-people-add-descriptions ()
  "Populate descriptions to all [[org-people:XXX]] links in the current buffer.

This ensures that all links have a description which matches the name of the
contact, descriptions are only added if they are missing."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    ;; Search for org-people links
    (while (re-search-forward "\\[\\[org-people:\\([^]]+\\)\\]\\]" nil t)
      (let ((target (match-string 1)))
        ;; Replace with [[org-people:XXX][XXX]]
        (replace-match (format "[[org-people:%s][%s]]" target target) t t)))))


;;
;; Cache setup
;;
;; Add appropriate hooks for automatic cache invalidation, if relevant.
;;

(when org-people-use-cache
  ;; Clear cache when Org structure changes.
  (add-hook 'org-element-cache-reset-hook #'org-people-clear-cache)
  ;; Clear cache when properties change.
  (add-hook 'org-property-changed-functions #'org-people-clear-cache)
  ;; Remove markers from buffers which are killed.
  (add-hook 'kill-buffer-hook
            (lambda ()
              (org-people-remove-dead-markers (current-buffer)))))

(provide 'org-people)
;;; org-people.el ends here
