aboutsummaryrefslogtreecommitdiff
path: root/.emacs.d/lisp/my/my-bbdb.el
diff options
context:
space:
mode:
Diffstat (limited to '.emacs.d/lisp/my/my-bbdb.el')
-rw-r--r--.emacs.d/lisp/my/my-bbdb.el190
1 files changed, 0 insertions, 190 deletions
diff --git a/.emacs.d/lisp/my/my-bbdb.el b/.emacs.d/lisp/my/my-bbdb.el
deleted file mode 100644
index 80661cd..0000000
--- a/.emacs.d/lisp/my/my-bbdb.el
+++ /dev/null
@@ -1,190 +0,0 @@
-;;; 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) (quit-window))
-
-(defun my-bbdb-all ()
- "Dispaly all bbdb records"
- (interactive)
- (bbdb ""))
-
-(provide 'my-bbdb)
-;;; my-bbdb.el ends here