;;; my-bbdb.el -- Extensions for bbdb -*- lexical-binding: t -*-

;; Copyright (C) 2023 Free Software Foundation.

;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "28.2"))

;; This file is part of dotfiles.

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

;; dotfiles 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 Affero General
;; Public License for more details.

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

;;; Commentary:

;; Extensions for bbdb.

;;; Code:


;; overrides bbdb-read-record in bbdb-com.el
(defun my-bbdb-read-record (&optional first-and-last)
  "Read and return a new BBDB record.
Does not insert it into the database or update the hashtables,
but does ensure that there will not be name collisions."
  (bbdb-editable)
  (let ((record (bbdb-empty-record)))
    ;; name
    (let (name)
      (bbdb-error-retry
       (setq name (bbdb-read-name first-and-last))
       (bbdb-check-name (car name) (cdr name)))
      (bbdb-record-set-firstname record (car name))
      (bbdb-record-set-lastname record (cdr name)))

    ;; akas
    (bbdb-record-set-aka record
			                   (bbdb-split 'aka (bbdb-read-string "AKAs: ")))

    ;; urls
    (bbdb-record-set-xfield record 'url (bbdb-read-string "urls: "))

    ;; mail
    (bbdb-record-set-mail
     record (bbdb-split 'mail (bbdb-read-string "E-Mail Addresses: ")))

    ;; notes
    (bbdb-record-set-xfield record 'notes (bbdb-read-string "notes: "))

    record))

;; overrides bbdb-create
;;;###autoload
(defun my-bbdb-create (record)
  "Add a new RECORD to BBDB.
When called interactively read all relevant info.
Do not call this from a program; call `bbdb-create-internal' instead."
  (interactive (list (bbdb-read-record current-prefix-arg)))
  (bbdb-change-record record)
  (bbdb-display-records (list record) nil nil t))

(defun my-bbdb-form (name)
  "Insert or update a bbdb record using a form.

If NAME exists in bbdb, update. Otherwise insert."
  (interactive
   (list (completing-read "Name: " (mapcar 'bbdb-record-name (bbdb-records)))))
  (let* ((record (or (car (bbdb-gethash name))
                     (bbdb-empty-record)))
         (new-first-name) (new-last-name))
    (switch-to-buffer-other-window "*Form BBDB*")
    (kill-all-local-variables)
    (let ((inhibit-read-only t)) (erase-buffer))
    (remove-overlays)
    (widget-insert "BBDB form\n\n")
    (setq my-bbdb-widget-first-name
          (widget-create 'editable-field :format "First Name: %v"
                         (or (bbdb-record-firstname record)
                             (car (bbdb-divide-name name)))))
    (setq my-bbdb-widget-last-name
          (widget-create 'editable-field :format "Last Name: %v"
                         (or (bbdb-record-lastname record)
                             (cdr (bbdb-divide-name name)))))
    (setq my-bbdb-widget-aka
          (widget-create 'editable-field
                         :format "Aliases: %v"
                         :value (bbdb-concat
                                 'aka
                                 (bbdb-record-aka record))))
    (setq my-bbdb-widget-org
          (widget-create 'editable-field
                         :format "Organisations: %v"
                         :value (bbdb-concat
                                 'organization
                                 (bbdb-record-organization record))))
    (setq my-bbdb-widget-mail
          (widget-create 'editable-field
                         :format "Email addresses: %v"
                         :value (bbdb-concat 'mail (bbdb-record-mail record))))
    (widget-insert "Phone numbers\n")
    (setq my-bbdb-widget-phone
          (widget-create 'editable-list
                         :entry-format "%i %d %v"
                         :value
                         (mapcar (lambda (phone-info)
                                   (list (aref phone-info 0)
                                         (aref phone-info 1)))
                                 (bbdb-record-phone record))
                         '(group
                           (menu-choice
                            :tag "Type"
                            (choice-item :value "cell")
                            (choice-item :value "work")
                            (choice-item :value "home")
                            (choice-item :value "other"))
                           (editable-field :format "number: %v" ""))))
    (widget-create
     'push-button
     :notify (lambda (&rest _)
               (setq new-first-name (widget-value my-bbdb-widget-first-name))
               (setq new-last-name (widget-value my-bbdb-widget-last-name))
               (unless (equal name
                              (bbdb-concat 'name-first-last new-first-name
                                           new-last-name))
                 (bbdb-check-name new-first-name new-last-name))
               (bbdb-record-set-name record new-first-name new-last-name)
               (bbdb-record-set-organization
                record (bbdb-split 'organization (widget-value my-bbdb-widget-org)))
               (bbdb-record-set-mail
                record (bbdb-split 'mail (widget-value my-bbdb-widget-mail)))
               (bbdb-record-set-aka
                record (bbdb-split 'aka (widget-value my-bbdb-widget-aka)))
               (bbdb-record-set-phone
                record (mapcar
                        (lambda (pair)
                          (vector (car pair) (cadr pair)))
                        (widget-value my-bbdb-widget-phone)))
               (bbdb-change-record record)
               (bbdb-display-records (list record) nil nil t))
     "Submit"))
  (use-local-map widget-keymap)
  (widget-setup)
  (goto-char (point-min)))

(defun my-bbdb-parse-record (record)
  (list
   (cons 'Name (bbdb-record-name record))
   (cons 'First-name (bbdb-record-firstname record))
   (cons 'Last-name (bbdb-record-lastname record))
   (cons 'Organisation (car (bbdb-record-organization record)))
   (cons 'Notes (bbdb-record-xfield record 'notes))
   (cons 'Website (bbdb-record-xfield record 'url))))

(defun my-bbdb-insert-record-to-org (parsed)
  (goto-char (point-min))
  (insert "\n* "(alist-get 'Name parsed))
  (insert "\n" (or
                (and (alist-get 'Notes parsed)
                     (format "- %s" (alist-get 'Notes parsed)))
                ""))
  (dolist (pair parsed)
    (when (and (not (member (car pair) '(Name Notes))) (cdr pair))
      (org-set-property (symbol-name (car pair)) (cdr pair)))))

(defun my--bbdb-to-org ()
  "ONLY do this in a new buffer!"
  (dolist (record (bbdb-records))
    (my-bbdb-insert-record-to-org (my-bbdb-parse-record record))))

(defun my-bbdb-done ()
  "Save and quit bbdb window"
  (interactive)
  (bbdb-save) (delete-window))

(defun my-bbdb-all ()
  "Dispaly all bbdb records"
  (interactive)
  (bbdb ""))

(defun my-bbdb-clean-mail (address)
  "Cleans email address."
  (setq address (bbdb-string-trim address))
  (cond ((string-match "\\`\\([^@+]+\\)\\+[^@]+\\(@.*\\)\\'" address)
		     (concat (match-string 1 address) (match-string 2 address)))
	      (t address)))

(provide 'my-bbdb)
;;; my-bbdb.el ends here