diff options
Diffstat (limited to '.emacs.d/lisp/my/my-bbdb.el')
| -rw-r--r-- | .emacs.d/lisp/my/my-bbdb.el | 190 |
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 |