Moving things one level deeper

To ease gnu stow usage. Now we can do

stow -t ~ emacs

1 files changed, 190 insertions, 0 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-bbdb.el b/emacs/.emacs.d/lisp/my/my-bbdb.el
new file mode 100644
index 0000000..80661cd
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/my-bbdb.el
@@ -0,0 +1,190 @@
+;;; 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